home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Tubes / Tubes6.AMOS / Tubes6.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1997-05-16  |  59.4 KB  |  2,173 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *            Tubes V1.7             *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. Hide 
  9. 'Screen Open 0,320,442,16,0
  10. 'Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  11. 'Screen Display 0,128,40,320,256 
  12. 'For A=0 To 15 : Colour A,A*$111 : Next  
  13. 'Wait Key  
  14. 'For A=0 To 63 
  15. '  Load Iff "C4D:Animationen/Tubes."+Lzstr$(A,4),0 
  16. '  Wait Vbl  
  17. '  For Y=15 To 48
  18. '    For X=0 To 63 
  19. '      P=Turbo Point(X,Y)
  20. '      If P Then Turbo Plot X,Y,16-P 
  21. '    Next  
  22. '  Next  
  23. '  Get Sprite 62+A,0,15 To 64,49 
  24. 'Next  
  25. 'Bank Delta Encode Start(3)+33852 To Start(3)+Length(3)
  26.  Extension_8_100C Start(3)+33852 To Start(3)+Length(3)
  27. 'End 
  28. ALLOCCHANNELS
  29. If DISA Then Erase 3
  30. If Chip Free>350000 Then NEWTITLE[0] Else NEWTITLE[1]
  31. RECORDPICTURE
  32. Dim D(31,1)
  33. Dim F(12,9)
  34. Dim HISC(15,1),HISC$(15)
  35. LOAHISC
  36. Restore TUBES
  37. Dim P(12,4)
  38. VO=0 : TB=0
  39. Global D(),F(),P(),VO,TB,HISC(),HISC$()
  40. For A=0 To 12
  41.   For B=0 To 4
  42.     Read P(A,B)
  43.   Next 
  44. Next 
  45. INIT
  46. SCORE=0 : LIQ=0
  47. Do 
  48.   CHECKSAV
  49.   If SG=0
  50.     TITLE
  51.     SCORE=0
  52.     Exit If Param=1
  53.   End If 
  54.   If Param=0 or SG=1
  55.     If SG=0
  56.       LEVEL=1
  57.     End If 
  58.     Do 
  59.       If SG=0
  60.         REBUILDGFX
  61.         NUMTUBES=Min(15+LEVEL*5,99) : TIME=45+LEVEL*15 : LEVDIF=Max(400-LEVEL*30,50)
  62.         SETTUBES[0]
  63.       Else 
  64.         REBUILDGFXSAVEGAME[Start(17)]
  65.         SETTUBES[Start(17)]
  66.         SG=0
  67.       End If 
  68.       WATERGO
  69.       Exit If Param
  70.       CLEANFIELDBONUS
  71.       If LEVEL mod 2
  72.         TIME=240-Min(LEVEL*10,120) : LEVDIF=1 : NUMTUBES=99
  73.         SHUFFLEBONUSGAME
  74.         WATERGO
  75.       Else 
  76.         TIME=360-Min(LEVEL*15,300) : LEVDIF=1 : NUMTUBES=Max(40-(LEVEL/2)*5,5)
  77.         TETRISBONUS
  78.       End If 
  79.       Inc LEVEL
  80.     Loop 
  81.     GAMEOVER
  82.   Else 
  83.     If Param=2
  84.       LEVEL=0
  85.       REBUILDGFX
  86.       NUMTUBES=999 : TIME=5999 : LEVDIF=0
  87.       SETTUBES[0]
  88.       WATERGO
  89.       SCORE=0
  90.     Else 
  91.       If Param=3
  92.         QUIT
  93.         INSTUCTIONS
  94.         INIT
  95.       Else 
  96.         QUIT
  97.         If Chip Free>350000
  98.           NEWTITLE[0]
  99.         Else 
  100.           NEWTITLE[1]
  101.         End If 
  102.         RECORDPICTURE
  103.         INIT
  104.       End If 
  105.     End If 
  106.   End If 
  107. Loop 
  108. QUIT
  109. End 
  110. TUBES:
  111.   Data 0,0,0,0,0
  112.   Data 1,0,1,0,1
  113.   Data 0,1,1,1,0
  114.   Data 1,1,1,1,1
  115.   Data 1,1,1,1,1
  116.   Data 0,0,2,1,1
  117.   Data 0,1,2,0,1
  118.   Data 1,0,2,1,0
  119.   Data 1,1,2,0,0
  120.   Data 0,0,1,0,1
  121.   Data 1,0,1,0,0
  122.   Data 0,0,1,1,0
  123.   Data 0,1,1,0,0
  124.  
  125. Procedure ALLOCCHANNELS
  126.   Shared SOU,MUS,DISA
  127.   Do 
  128.     SOU=1 : MUS=1 : DISA=0
  129.     Trap Extension_8_0956 
  130.     If Errtrap
  131.       SOU=0 : MUS=0 : DISA=1
  132.       Screen Open 0,320,64,2,0
  133.       Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  134.        Extension_8_1204 12
  135.       Palette 0,0
  136.       T2[0,"COULD NOT ALLOCATE"]
  137.       T2[16,"AUDIO CHANNELS"]
  138.       T2[32,"(R)ETRY OR (C)ONTINUE"]
  139.       T2[48,"WITHOUT SOUND?"]
  140.       Fade 1,0,$F80
  141.       Repeat 
  142.         Multi Wait : I$=Lower$(Inkey$)
  143.       Until I$="r" or I$="c"
  144.       Fade 1 : For A=0 To 15 : Multi Wait : Next 
  145.       Screen Close 0
  146.       Exit If I$="c"
  147.     Else 
  148.       Exit 
  149.     End If 
  150.   Loop 
  151. End Proc
  152. Procedure RECORDPICTURE
  153.   If Exist("TubesRecord.iff")
  154.     Screen Open 1,16,16,2,0 : Screen Hide 
  155.     Load Iff "TubesRecord.iff",0 : Screen Hide 
  156.     Screen 1 : Get Palette 0
  157.     Screen 0 : For A=0 To 31 : Colour A,0 : Next 
  158.      Extension_8_1204 12
  159.     Ink 1 : Gr Writing 0
  160.     T3[24,"LAST SAVED"]
  161.     T3[56,"TUBES RECORD"]
  162.     Screen Show 
  163.     Fade 1 To 1
  164.     For A=0 To 299
  165.       Exit If Inkey$<>"" or Mouse Key<>0 or Fire(1)<>0
  166.       Multi Wait 
  167.     Next 
  168.     Fade 1
  169.     For A=0 To 15 : Multi Wait : Next 
  170.     Screen Close 0
  171.     Screen Close 1
  172.   End If 
  173. End Proc
  174. Procedure INSTUCTIONS
  175.   Shared SOU,MUS
  176.   Screen Open 0,640,256,2,$8000
  177.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  178.   Palette $888,0 : Colour Back $888
  179.   F$="Tubes.doc"
  180.   Trap Extension_8_0EA2 F$,8
  181.   If Errtrap
  182.     Locate 0,15 : Centre "Could not load Tubes.doc."
  183.     For A=0 To 199
  184.       Multi Wait 
  185.       Exit If Mouse Key<>0 or Fire(1)<>0 or Inkey$<>""
  186.     Next 
  187.     Colour Back 0 : Screen Close 0
  188.     Pop Proc
  189.   End If 
  190.   POS=0 : ST=Start(8) : LE=Length(8)
  191.   LIN=0
  192.   For A=ST To ST+LE
  193.     If Peek(A)=10 Then Inc LIN
  194.   Next 
  195.   Reserve As Work 18,LIN*8+8
  196.   OST=ST : LIN=0 : TST=Start(18)
  197.   For A=ST To ST+LE
  198.     If Peek(A)=10 Then Loke TST+LIN*8,OST : Loke TST+LIN*8+4,A-OST : Inc LIN : OST=A+1
  199.   Next 
  200.   Loke TST+LIN*8,OST : Loke TST+LIN*8+4,A-OST-1 : Inc LIN
  201.   If MUS Then Extension_8_10C6 64 : Extension_8_109E 3,44
  202.   Scroll Off 
  203.   For A=0 To 31
  204.     Locate 0,A : Print Peek$(Leek(TST+(POS+A)*8),Leek(TST+(POS+A)*8+4))
  205.   Next 
  206.   Do 
  207.     Multi Wait 
  208.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  209.     MK=Mouse Key : I$=Inkey$
  210.     If(I$=Cdown$ or MK=1 or Jdown(1)<>0) and POS<LIN-32 Then Gosub TDOWN
  211.     If(I$=Cup$ or MK=2 or Jup(1)<>0) and POS>0 Then Gosub TUP
  212.     Exit If MK=3 or I$=Chr$(27)
  213.   Loop 
  214.   Erase 18
  215.   Erase 8
  216.   Colour Back 0 : Screen Close 0
  217.   If MUS Then Extension_8_10A8 
  218. Pop Proc
  219. TUP:
  220.   Screen Copy 0,0,0,640,248 To 0,0,8
  221.   Dec POS
  222.   A$=Peek$(Leek(TST+POS*8),Leek(TST+POS*8+4))
  223.   Locate 0,0 : Print A$;Space$(80-Len(A$));
  224. Return 
  225. TDOWN:
  226.   Screen Copy 0,0,8,640,256 To 0,0,0
  227.   Inc POS
  228.   A$=Peek$(Leek(TST+POS*8+248),Leek(TST+POS*8+252))
  229.   Locate 0,31 : Print A$;Space$(80-Len(A$));
  230. Return 
  231. End Proc
  232. Procedure NEWTITLE[CHIP]
  233.   On Error Goto ERR
  234.   Shared MUS,SOU
  235.   RASLIN=180-( Extension_8_060E =68000)*20
  236.   If CHIP=1 Then Goto LOWCHIP
  237.   If Length(32)
  238.     Unpack 32 To 0 : Screen Hide 
  239.     For A=0 To 63
  240.       Get Bob 62+A,(A mod 5)*64,(A/5)*34 To(A mod 5)*64+64,(A/5)*34+34
  241.     Next 
  242.     Screen Close 0
  243.     Erase 32
  244.   End If 
  245.   Unpack 13 To 0
  246.   Screen Open 1,320,256,16,0 : Screen Hide 
  247.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  248.   Screen Open 2,320,256,16,0 : Screen Hide 
  249.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  250.   Screen Open 3,320,256,16,0 : Screen Hide 
  251.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  252.   Screen Open 4,320,256,16,0 : Screen Hide 
  253.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  254.   Screen Open 6,320,256,2,0 : Screen Hide 
  255.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  256.    Extension_8_1204 12
  257.   Gr Writing 0
  258.   Screen Open 7,320,256,2,0 : Screen Hide 
  259.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  260.   Palette 0,$F
  261.    Extension_8_128A 7
  262.   MX=160 : MY=128
  263.   WIN=0 : ZP=0 : S=4 : W=32 : DD=Rnd(1023) : T1=Rnd(5)+1 : T2=Rnd(5)+1
  264.   If Extension_8_060E =68000 Then W=64
  265.   FRAME=0 : ANI=0 : BLPC=0
  266.   Screen 7
  267.   Repeat 
  268.     Gosub DRARING
  269.   Until ANI=1
  270.   Screen 0
  271.   Double Buffer : Autoback 0
  272.   G=$FFF
  273.   Fade 3,0,$1,$2,$3,$4,$5,$6,$7,$0,$2,$4,$6,$8,$A,$C,$E,$0,$111,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$BBB,$CCC,$DDD,$EEE,$FFF
  274.   Screen 7
  275.   FAD=0
  276.   If MUS
  277.      Extension_8_10C6 64
  278.      Extension_8_10F2 0
  279.      Extension_8_109E 3,0
  280.   End If 
  281.   TITLE=1 : TIME=400 : OANI=ANI : SPRANI=0
  282.   COMAP=1 : SPRX=Rnd(192)+64 : SPRY=Rnd(100)
  283.   SPRSY=0 : SPRSX=(Rnd(4)+1)*(Rnd(1)*2-1)
  284.   Clear Key 
  285.   Do 
  286.     While Amos Here=0 : Multi Wait : Wend 
  287.     Multi Wait 
  288.     If COMAP
  289.       Sprite 0,X Hard(SPRX),Y Hard(SPRY/4),62+SPRANI : Add SPRANI,1,0 To 63
  290.       Add SPRY,SPRSY
  291.       If SPRY>888
  292.         SPRSY=-Rnd(27)-15
  293.       Else 
  294.         Inc SPRSY
  295.       End If 
  296.       Add SPRX,SPRSX
  297.       If SPRX<0 or SPRX>255
  298.         SPRX=Min(Max(SPRX,0),255)
  299.         SPRSX=-SPRSX
  300.       End If 
  301.     End If 
  302.     Exit If Mouse Key<>0 or Inkey$<>"" or Fire(1)<>0
  303.     If FAD=-1 Then Extension_8_12B2 6,0 To 0,4 : FAD=0
  304.     If FAD=0
  305.        Extension_8_12B2 3-ANI*2+BLPC/4,BLPC and 3 To 0,3
  306.       Add BLPC,1,0 To 7
  307.       Repeat 
  308.         Gosub DRARING
  309.       Until Extension_8_0338 >RASLIN
  310.     Else 
  311.       Screen 0
  312.       If Colour(0)=G and FAD>0
  313.         Screen 6
  314.          Extension_8_121C 6,0
  315.         On TITLE Gosub T1,T2,T3,T4,T5,T6
  316.         Add TITLE,1,1 To 6
  317.          Extension_8_12B2 6,0 To 0,4
  318.         Screen 0
  319.         If COMAP=0
  320.           Fade 1,0,$1,$2,$3,$4,$5,$6,$7,$0,$2,$4,$6,$8,$A,$C,$E,$FFF,$EFE,$DFD,$CFC,$BFB,$AFA,$9F9,$8F8,$FFF,$DFD,$BFB,$9F9,$7F7,$5F5,$3F3,$1F1
  321.         Else 
  322.           Fade 1,0,$1,$2,$3,$4,$5,$6,$7,$0,$2,$4,$6,$8,$A,$C,$E,$0,$111,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$BBB,$CCC,$DDD,$EEE,$FFF
  323.         End If 
  324.          Extension_8_12B2 3-ANI*2+BLPC/4,BLPC and 3 To 0,3
  325.         FAD=-1
  326.       Else 
  327.          Extension_8_12B2 1+ANI*2+BLPC/4,BLPC and 3 To 0,3
  328.       End If 
  329.       Screen 7
  330.       Add BLPC,1,0 To 7
  331.     End If 
  332.     If OANI<>ANI
  333.       If TIME>300
  334.         OANI=ANI
  335.         Screen 0
  336.         Fade 1,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G,G
  337.         FAD=1
  338.         Screen 7 : TIME=0
  339.       Else 
  340.         FAD=1
  341.       End If 
  342.     End If 
  343.     Screen Swap 0 : Inc TIME
  344.   Loop 
  345.   Screen 0
  346.   Sprite Off 
  347.   Fade 3
  348.   For A=0 To 64
  349.     If MUS Then Extension_8_10C6 64-A
  350.      Extension_8_12B2 3-ANI*2+BLPC/4,BLPC and 3 To 0,3
  351.     Add BLPC,1,0 To 7
  352.     Screen Swap 0 : Wait Vbl 
  353.   Next 
  354.   If MUS Then Extension_8_10A8 
  355.   Screen Close 0
  356.   Screen Close 1
  357.   Screen Close 2
  358.   Screen Close 3
  359.   Screen Close 4
  360.   Screen Close 6
  361.   Screen Close 7
  362. Pop Proc
  363. LOWCHIP:
  364.   Close Workbench 
  365.   Screen Open 0,320,256,4,0
  366.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  367.   Palette 0,0,0,0
  368.   Screen Open 1,320,256,16,0 : Screen Hide 
  369.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  370.   Screen Open 2,320,256,16,0 : Screen Hide 
  371.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  372.   Screen Open 6,320,256,2,0 : Screen Hide 
  373.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  374.    Extension_8_1204 12
  375.   Gr Writing 0
  376.   Screen Open 7,320,256,2,0 : Screen Hide 
  377.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  378.    Extension_8_128A 7
  379.   MX=160 : MY=128
  380.   WIN=0 : ZP=0 : S=2 : W=32 : DD=Rnd(1023) : T1=Rnd(5)+1 : T2=Rnd(5)+1
  381.   If Extension_8_060E =68000 Then W=64
  382.   FRAME=0 : ANI=0 : BLPC=0
  383.   Screen 7
  384.   Repeat 
  385.     Gosub DRARING
  386.   Until ANI=1
  387.   Screen 0
  388.   Double Buffer : Autoback 0
  389.   G=$FFF
  390.   Fade 3,0,$F,G,G
  391.   Screen 7
  392.   FAD=0
  393.    Extension_8_10C6 64
  394.    Extension_8_10F2 0
  395.    Extension_8_109E 3,0
  396.   TITLE=1 : TIME=300 : OANI=ANI
  397.   Do 
  398.     While Amos Here=0 : Multi Wait : Wend 
  399.     Multi Wait 
  400.     Exit If Mouse Key<>0 or Inkey$<>"" or Fire(1)<>0
  401.     If FAD=-1 Then Extension_8_12B2 6,0 To 0,1 : FAD=0
  402.     If FAD=0
  403.        Extension_8_12B2 2-ANI,BLPC To 0,0
  404.       Add BLPC,1,0 To 3
  405.       Repeat 
  406.         Gosub DRARING
  407.       Until Extension_8_0338 >RASLIN
  408.     Else 
  409.       Screen 0
  410.       If Colour(0)=G and FAD>0
  411.         Screen 6
  412.          Extension_8_121C 6,0
  413.         On TITLE Gosub T1,T2,T3,T4,T5,T6
  414.         Add TITLE,1,1 To 6
  415.          Extension_8_12B2 6,0 To 0,1
  416.         Screen 0
  417.         Fade 1,0,$F,G,G
  418.          Extension_8_12B2 2-ANI,BLPC To 0,0
  419.         FAD=-1
  420.       Else 
  421.          Extension_8_12B2 1+ANI,BLPC To 0,0
  422.       End If 
  423.       Screen 7
  424.       Add BLPC,1,0 To 3
  425.     End If 
  426.     If OANI<>ANI
  427.       If TIME>300
  428.         OANI=ANI
  429.         Screen 0
  430.         Fade 1,G,G,G,G
  431.         FAD=1
  432.         Screen 7
  433.       Else 
  434.         FAD=1
  435.       End If 
  436.     End If 
  437.     Screen Swap 0 : Inc TIME
  438.   Loop 
  439.   Screen 0
  440.   Fade 3
  441.   For A=0 To 64
  442.      Extension_8_10C6 64-A
  443.      Extension_8_12B2 2-ANI,BLPC To 0,0
  444.     Add BLPC,1,0 To 3
  445.     Screen Swap 0 : Wait Vbl 
  446.   Next 
  447.    Extension_8_10A8 
  448.   Screen Close 0
  449.   Screen Close 1
  450.   Screen Close 2
  451.   Screen Close 6
  452.   Screen Close 7
  453.   QUIT:
  454. Pop Proc
  455. T1:
  456.   COMAP=0 : Sprite Off 
  457.   T2[8,"WELCOME TO"]
  458.   Paste Bob 0,32,61
  459.   T2[112,"                V1.7"]
  460. '  T2[168,"EXCLUSIVE APC&TCP"] 
  461. '  T2[184,"FULL VERSION"]
  462.   T2[168,"SPECIAL VERSION FOR"]
  463.   T2[184,"BERLINER SPIELEKISTE"]
  464. Return 
  465. T2:
  466.   T2[8,"CREDITS"]
  467.   T2[20,"-------"]
  468.   T2[56,"CODING"]
  469.   T2[80,"CHRIS HODGES"]
  470.   T2[112,"GRAPHICS"]
  471.   T2[136,"CHRIS HODGES"]
  472.   T2[152,"MICHAEL KLEINER"]
  473.   T2[184,"MUSIC AND SFX"]
  474.   T2[208,"CHRIS HODGES"]
  475. Return 
  476. T3:
  477.   T2[8,"CREDITS"]
  478.   T2[20,"-------"]
  479.   T2[56,"ADDITIONAL IDEAS"]
  480.   T2[80,"MICHAEL KLEINER"]
  481.   T2[96,"PAUL-GERHARD GEBAUER"]
  482.   T2[112,"MICHAEL UFER"]
  483.   T2[128,"MATHIAS MISCHLER"]
  484.   T2[160,"MORAL SUPPORT"]
  485.   T2[184,"MICHAEL KLEINER"]
  486.   T2[200,"PAUL-GERHARD GEBAUER"]
  487.   T2[216,"MATHIAS MISCHLER"]
  488.   T2[232,"THOMAS BUETTNER"]
  489. Return 
  490. T4:
  491.   T2[8,"DEDICATED TO"]
  492.   T2[32,"MICHAEL KLEINER AND"]
  493.   T2[48,"MELANIE BARYGA"]
  494.   T2[80,"GREETINGS TO"]
  495.   T2[104,"FRITZ, VIP, AMIGAMAN"]
  496.   T2[120,"BRAUMEISTER, MERLIN"]
  497.   T2[136,"KRIEGSHELD, VINZENZ"]
  498.   T2[152,"RED REBEL, THE GOD"]
  499.   T2[168,"MAGIC, HOLGER, CLAW"]
  500.   T2[184,"SCHNEEMANN, SMT, A23"]
  501.   T2[200,"WOTAN, KILLER, RALLI"]
  502.   T2[216,"REYEM, MARVIN, HARRY"]
  503.   T2[232,"RALF, MARKUS, HANS"]
  504. Return 
  505. T5:
  506.   COMAP=1 : SPRX=Rnd(192)+64 : SPRY=Rnd(100) : SPRSY=0 : SPRSX=(Rnd(4)+1)*(Rnd(1)*2-1)
  507. '  Change Bank Font 14 
  508. '  T2[250,"IF YOU CAN READ THIS YOUR EYES ARE VERY GOOD!"] 
  509. '  Change Bank Font 12 
  510. Return 
  511. T6:
  512. '  COMAP=0 : Sprite Off  
  513. '  T2[8,"BRAUMEISTER RULEZ!"]
  514. '  T2[40,"CALL"] 
  515. '  T2[56,"SIXPACK BBS"]
  516. '  T2[88,"MODEM"]
  517. '  T2[112,"+49-631-33557 "]
  518. '  T2[128,"+49-631-33612 "]
  519. '  T2[144,"+49-631-793025"]
  520. '  T2[168,"ISDN"]
  521. '  T2[192,"+49-631-793023"]
  522. '  T2[208,"+49-631-793025"]
  523. '  T2[232,"ONLY LEGAL STUFF!"] 
  524. Return 
  525. DRARING:
  526.   If WIN=0
  527.     If Z=0 : Extension_8_121C 7,0 : End If 
  528.     ZZ=((Z+ZP) and 63)+1
  529.     D2= Extension_8_1114(ZZ*T1+DD,700)
  530.     D3= Extension_8_1106(ZZ*T2+DD,700)
  531.     WW=PP*W
  532.     WIN=WW+1024
  533.   Else 
  534.     Z1=1024/ZZ : Z2=1024/(ZZ+S)
  535.     X1= Extension_8_1114(WIN,Z1)+MX+D2/Z1
  536.     Y1= Extension_8_1106(WIN,Z1)+MY+D3/Z1
  537.     X2= Extension_8_1114(WIN+W,Z1)+MX+D2/Z1
  538.     Y2= Extension_8_1106(WIN+W,Z1)+MY+D3/Z1
  539.      Extension_8_1030 X1,Y1 To X2,Y2,1,-1
  540.     X3= Extension_8_1114(WIN+W,Z2)+MX+D2/Z2
  541.     Y3= Extension_8_1106(WIN+W,Z2)+MY+D3/Z2
  542.      Extension_8_1030 X2,Y2 To X3,Y3,1,-1
  543.     X4= Extension_8_1114(WIN,Z2)+MX+D2/Z2
  544.     Y4= Extension_8_1106(WIN,Z2)+MY+D3/Z2
  545.      Extension_8_1030 X3,Y3 To X4,Y4,1,-1
  546.      Extension_8_1030 X4,Y4 To X1,Y1,1,-1
  547.     Add WIN,W*2
  548.     If WIN>2047+WW
  549.       WIN=0
  550.       PP=1-PP
  551.       Add Z,S
  552.       If Z>63
  553.         Z=0
  554.         If CHIP=0
  555.            Extension_8_1058 7,0 To 1+ANI*2+FRAME/4,FRAME and 3
  556.         Else 
  557.            Extension_8_1058 7,0 To 1+ANI,FRAME
  558.         End If 
  559.         Inc FRAME : Add ZP,-1
  560.         If FRAME=8-CHIP*4
  561.           ANI=1-ANI : FRAME=0 : DD=Rnd(1023) : T1=Rnd(5)+1 : T2=Rnd(5)+1
  562.           ZP=0
  563.         End If 
  564.       End If 
  565.     End If 
  566.   End If 
  567. Return 
  568. ERR:
  569.   For A=0 To 7 : Trap Screen Close A : Next 
  570.    Extension_8_10A8 
  571. Resume QUIT
  572. End Proc
  573. Procedure INIT
  574.   Screen Open 2,320,256,2,0 : Screen Hide 
  575.   Curs Off 
  576.    Extension_8_1204 10
  577.   TB=Text Base
  578.   Unpack 9 To 1 : Screen Hide 
  579.   For A=0 To 12
  580.     Get Block A+1,A*16,0,16,16,1
  581.     Get Bob A+1,A*16,0 To A*16+16,16
  582.   Next 
  583.   NEWTUBCOL
  584.   Screen Open 0,320,256,16,0
  585.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  586.   For A=0 To 31 : Colour A,0 : Next 
  587. End Proc
  588. Procedure NEWTUBCOL
  589.   Shared LIQ,CURVSAM,CURVFREQ
  590.   S=Screen
  591.   Screen 1
  592.   Repeat 
  593.     TCOL=Rnd(4095)
  594.     RV= Extension_8_03B2(TCOL) : GV= Extension_8_03C0(TCOL) : BV= Extension_8_03D0(TCOL)
  595.   Until RV+GV+BV>32
  596.   Colour 5,TCOL
  597.   Colour 6, Extension_8_0A0E((RV*3)/5,(GV*3)/5,(BV*3)/5)
  598.   Colour 7, Extension_8_0A0E((RV*3)/8,(GV*3)/8,(BV*3)/8)
  599.   If LIQ=0 Then AC1=$F : AC2=-$440 : CURVSAM=13 : CURVFREQ=9000
  600.   If LIQ=1 Then AC1=-$444 : AC2=0 : CURVSAM=24 : CURVFREQ=10000
  601.   If LIQ=2 Then AC1=$444 : AC2=0 : CURVSAM=17 : CURVFREQ=16500
  602.   For A=0 To 7
  603.     Colour A+8, Extension_8_0EFC( Extension_8_0EFC(Colour(A),AC1,0 To $FFF),AC2,0 To $FFF)
  604.   Next 
  605.   For A=0 To 15
  606.     Colour A+16, Extension_8_0EFC(Colour(A),$444,0 To $FFF)
  607.   Next 
  608.   Screen 2
  609.   Get Palette 1
  610.   For A=0 To 7 : Colour A, Extension_8_0EFC(Colour(A),-$222,0 To $FFF) : Next 
  611.   For A=0 To 7 : Colour A+8,Colour(A) : Next 
  612.   If S<>-1 Then Screen S
  613. End Proc
  614. Procedure QUIT
  615.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  616.   Screen Close 1
  617.   Screen Close 2
  618.   Screen Close 0
  619. End Proc
  620. Procedure TITLE
  621.   Shared SCORE,LEVEL,SOU,MUS,DISA,LIQ
  622.   Dim YN$(1),LIQ$(2)
  623.   YN$(0)="Off "
  624.   YN$(1)="On  "
  625.   LIQ$(0)="Water"
  626.   LIQ$(1)="Oil  "
  627.   LIQ$(2)="Milk "
  628.   NEWTUBCOL
  629.   Screen 0
  630.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  631.   Cls 0
  632.   Screen Copy 1,0,16,320,80 To 0,0,0
  633.   Ink 15,0 : Set Pattern -1
  634.   Bar 0,64 To 320,256
  635.   Put Block 6,0,64
  636.   Put Block 7,304,64
  637.   Put Block 8,0,240
  638.   Put Block 9,304,240
  639.   For A=1 To 18
  640.     Put Block 3,A*16,64
  641.     Put Block 3,A*16,240
  642.   Next 
  643.   For A=5 To 14
  644.     Put Block 2,0,A*16
  645.     Put Block 2,304,A*16
  646.   Next 
  647.   If MUS
  648.      Extension_8_10C6 64
  649.      Extension_8_10F2 0
  650.     If SCORE>HISC(15,0)
  651.        Extension_8_109E 3,30
  652.     Else 
  653.        Extension_8_109E 3,0
  654.     End If 
  655.   Else 
  656.     If SOU
  657.        Extension_8_13C6 3
  658.     End If 
  659.   End If 
  660.   Fade 1 To 2 : For A=0 To 14 : Multi Wait : Next 
  661.   Clear Key 
  662.   PAG=0
  663.   If SCORE>HISC(15,0) Then Gosub ENTERHISC
  664.   MPOS=4
  665.   Limit Mouse X Hard(16),Y Hard(128+DISA*32) To X Hard(14*16-1),Y Hard(223)
  666.   Multi Wait 
  667.   Y Mouse=Y Hard(144+MPOS*16) : PAR=0 : PAGCO=0
  668.   Do 
  669.     Do 
  670.       While Amos Here=0 : Multi Wait : Wend 
  671.       If PAG=0 Then Gosub CREDIZ Else Gosub HISCORE
  672.        Extension_8_128A 2
  673.        Extension_8_12B2 2,0 To 0,3
  674.        Extension_8_1258 : Wait Vbl 
  675.       Screen 2 : For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  676.       Fade 2 To 2
  677.       For A=0 To 31 : Multi Wait : Next 
  678.       For A=0 To 199
  679.         I$=Inkey$ : MK=Mouse Key or Fire(1)
  680.         Multi Wait 
  681.         Exit If I$<>"" or MK<>0,2
  682.       Next 
  683.       If PAGCO=7 Then PAR=4 : Exit 2
  684.       Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  685.       Fade 1 To 2
  686.       For A=0 To 15 : Multi Wait : Next 
  687.       PAG=1-PAG : Inc PAGCO
  688.     Loop 
  689.     If I$=Chr$(27) Then PAR=1 : Exit 
  690.      Extension_8_128A 2
  691.     Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  692.     Fade 1 To 2
  693.     For A=0 To 15 : Multi Wait : Next 
  694.     Gosub MENUTEXT
  695.      Extension_8_12B2 2,0 To 0,3
  696.      Extension_8_1258 : Wait Vbl 
  697.     Screen 2 : For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  698.     Fade 2 To 2
  699.     TIM=0
  700.     Colour 17,$FFF : Colour 18,$888 : Colour 19,0
  701.     OMK=0 : PAGCO=0
  702.     Repeat 
  703.       While Amos Here=0 : Multi Wait : Wend 
  704.       Multi Wait : Inc TIM
  705.       JM=(Jup(1)-Jdown(1))*2
  706.       YM=Y Screen(Y Mouse)+JM : I$=Inkey$
  707.       If JM Then Y Mouse=Y Hard(YM)
  708.       MK=Mouse Key
  709.       If I$=" " or Fire(1)<>0 Then MK=1
  710.       MPOS=(YM-120)/16
  711.       If I$=Cdown$ Then MPOS=Min(MPOS+1,6) : YM=MPOS*16+128 : OYM=YM : TIM=1
  712.       If I$=Cup$ Then MPOS=Max(MPOS-1,DISA*2) : YM=MPOS*16+128 : OYM=YM : TIM=1
  713.       Exit If I$=Chr$(27)
  714.       If OYM<>YM
  715.         TIM=0 : OYM=YM
  716.       Else 
  717.         If TIM and 1
  718.           Y Mouse=Y Hard(YM+Sgn((MPOS*16+128)-YM))
  719.         End If 
  720.       End If 
  721.       If MK<>0 and OMK=0
  722.         If MPOS=0
  723.           MUS=1-MUS
  724.           If MUS=0
  725.              Extension_8_10A8 
  726.           Else 
  727.              Extension_8_108E 3
  728.           End If 
  729.           T[128,"Music: "+YN$(MUS)]
  730.         End If 
  731.         If MPOS=1
  732.           SOU=1-SOU
  733.           T[144,"Sound: "+YN$(SOU)]
  734.         End If 
  735.         If MPOS=2
  736.           Add LIQ,1,0 To 2
  737.           T[160,"Liquid: "+LIQ$(LIQ)]
  738.         End If 
  739.         If MPOS=3 : PAR=3 : Exit 2 : End If 
  740.         If MPOS=4 : PAR=2 : Exit 2 : End If 
  741.         Exit If MPOS=5,2
  742.         If MPOS=6 : PAR=1 : Exit 2 : End If 
  743.          Extension_8_12B2 2,0 To 0,3
  744.       End If 
  745.       OMK=MK
  746.       Sprite 0,X Hard(100),Y Hard(YM+2),42
  747.       Sprite 1,X Hard(220),Y Hard(YM+2),44
  748.     Until TIM>400
  749.     Sprite Off 
  750.     Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  751.     Fade 1 To 2
  752.     For A=0 To 15 : Multi Wait : Next 
  753.   Loop 
  754.   Sprite Off 
  755.   If MUS Then For A=64 To 0 Step -2 : Extension_8_10C6 A : Multi Wait : Next : Extension_8_10A8 
  756. Pop Proc[PAR]
  757. ENTERHISC:
  758.   For A=15 To 1 Step -1
  759.     If SCORE>HISC(A,0) Then RANK=A Else Exit 
  760.   Next 
  761.   For A=14 To RANK Step -1
  762.     HISC$(A+1)=HISC$(A)
  763.     HISC(A+1,0)=HISC(A,0)
  764.     HISC(A+1,1)=HISC(A,1)
  765.   Next 
  766.   HISC$(RANK)=Space$(12)
  767.   HISC(RANK,0)=SCORE
  768.   HISC(RANK,1)=LEVEL
  769.   Gosub HISCORE
  770.   T[232,"You made it! Enter your name!"]
  771.    Extension_8_128A 2
  772.    Extension_8_12B2 2,0 To 0,3
  773.    Extension_8_1258 : Wait Vbl 
  774.   Screen 2 : For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  775.   Fade 2 To 2
  776.   POS=1
  777.   NAME$=Space$(12)
  778.   C=0
  779.   Do 
  780.     Multi Wait 
  781.     I$=Inkey$
  782.     If I$="" Then Inc C Else C=0
  783.     Exit If I$=Chr$(13) or C>1500
  784.     If I$=Chr$(8) and POS>1 Then Dec POS : Mid$(NAME$,POS,1)=" "
  785.     If I$>Chr$(31) and POS<13 Then Mid$(NAME$,POS,1)=I$ : Inc POS
  786.     Screen 2
  787.     Text 92,104+RANK*8+TB,NAME$
  788.     Screen 0
  789.     If(Timer and $F)=0 Then Extension_8_12B2 2,0 To 0,3
  790.   Loop 
  791.   If NAME$="" Then NAME$= Extension_8_16A4("MR.ANONYMOUS|* LAZY GUY *|MR. NO NAME!",Rnd(2))
  792.   HISC$(RANK)=NAME$
  793.   Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  794.   Fade 1 To 2
  795.   For A=0 To 15 : Multi Wait : Next 
  796.   PAG=1-PAG
  797.   SAVHISC
  798. Return 
  799. MENUTEXT:
  800.    Extension_8_121C 2,0
  801.   T[80,"Welcome to Tubes V1.7"]
  802.   T[104,"Select option:"]
  803.   T[128,"Music: "+YN$(MUS)]
  804.   T[144,"Sound: "+YN$(SOU)]
  805.   T[160,"Liquid: "+LIQ$(LIQ)]
  806.   T[176,"Instructions"]
  807.   T[192,"Practice"]
  808.   T[208,"Start Game"]
  809.   T[224,"Quit Game"]
  810. Return 
  811. CREDIZ:
  812.    Extension_8_121C 2,0
  813.   T[80,"Welcome to Tubes V1.7"]
  814.   T[104,"Written by Chris Hodges"]
  815.   T[128,"Main graphics by Chris Hodges"]
  816.   T[144,"Additional graphics by"]
  817.   T[152,"Michael Kleiner"]
  818.   T[168,"Music and Sfx by Chris Hodges"]
  819.   T[184,"Additional ideas by Michael Kleiner"]
  820.   T[192,"Paul Gebauer, Michael Ufer and"]
  821.   T[200,"Mathias Mischler"]
  822.   T[224,"Enjoy..."]
  823. Return 
  824. HISCORE:
  825.    Extension_8_121C 2,0
  826.   T[80,"Best Tubers"]
  827.   T[96,"  Rank Name         Score Level"]
  828.   For A=1 To 15
  829.     T$= Extension_8_0EC8(A,2)+". "+HISC$(A)+" "+ Extension_8_0EB8(HISC(A,0),5)+" "+ Extension_8_0EB8(HISC(A,1),2)
  830.     T[104+A*8,T$]
  831.   Next 
  832. Return 
  833. End Proc
  834. Procedure T3[Y,T$]
  835.   XX=160-Text Length(T$)/2
  836.   YY=Y+Text Base
  837.   Ink 0
  838.   Text XX-2,YY,T$
  839.   Text XX+2,YY,T$
  840.   Text XX,YY-2,T$
  841.   Text XX,YY+2,T$
  842.   Ink 4
  843.   Text XX-1,YY-1,T$ : Text XX+1,YY-1,T$
  844.   Text XX-1,YY+1,T$ : Text XX+1,YY+1,T$
  845.   Ink 3
  846.   Text XX-1,YY,T$
  847.   Text XX+1,YY,T$
  848.   Text XX,YY-1,T$
  849.   Text XX,YY+1,T$
  850.   Ink 1 : Text XX,YY,T$
  851. End Proc
  852. Procedure T2[Y,T$]
  853.   Text 160-Text Length(T$)/2,Y+Text Base,T$
  854. End Proc
  855. Procedure T[Y,T$]
  856.   Screen 2
  857.   Text 160-Text Length(T$)/2,Y+TB,T$
  858.   Screen 0
  859. End Proc
  860. Procedure GAMEOVER
  861.   Shared SCORE,MUS
  862.   Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  863.   Fade 2 To 2
  864.   Screen 2
  865.    Extension_8_1204 11 : TB=Text Base
  866.    Extension_8_121C 2,0
  867.   T[128,"Game Over"]
  868.   T[160,"Score: "+ Extension_8_0EB8(SCORE,5)]
  869.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  870.    Extension_8_128A 2
  871.    Extension_8_12B2 2,0 To 0,3
  872.   If MUS Then Extension_8_109E 3,49
  873.    Extension_8_1258 : Wait Vbl 
  874.   For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  875.   Fade 1 To 2
  876.   For A=1 To 175 : Multi Wait : Next 
  877. End Proc
  878. Procedure CHECKSAV
  879.   Shared SG,LEVEL
  880.   If Exist("Tubes.sav")
  881.      Extension_8_0456 "Tubes.sav",17
  882.     SEARCHCHUNK[Start(17),"ENVI"]
  883.     ADR=Param+8
  884.     CTIM=Leek(ADR) : CDAT=Leek(ADR+4) : Add ADR,8
  885.     CT= Extension_8_07E0 
  886.     DTIM=( Extension_8_0830(CT)*60+ Extension_8_083E(CT))-( Extension_8_0830(CTIM)*60+ Extension_8_083E(CTIM))
  887.     DDAT=( Extension_8_07CE -CDAT)*1440
  888.     If DTIM+DDAT>9
  889.       SEARCHCHUNK[Start(17),"MODE"]
  890.       MD=Leek(Param+8)
  891.       If MD=$100
  892.         SEARCHCHUNK[Start(17),"VARS"]
  893.         LEVEL=Deek(Param+8)
  894.         SG=1
  895.       Else 
  896.         SG=0
  897.       End If 
  898.       Kill "Tubes.Sav"
  899.     Else 
  900.       Screen Open 7,640,17,2,$8000
  901.       Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  902.       Palette 0,0
  903.       Screen Display 7,128,164,320,16
  904.       RT=10-(DTIM+DDAT)
  905.       If RT<>1
  906.         Centre "Sorry, but you must wait"+Str$(RT)+" minutes before you can play again."
  907.       Else 
  908.         Centre "Sorry, but you must wait one minute before you can play again."
  909.       End If 
  910.       Print 
  911.       Centre "(Press any key to quit or 'Help' to kill saved game)"
  912.       Fade 1,0,$FFF : Multi Wait 
  913.       Repeat 
  914.         Multi Wait : I$=Inkey$ : SCAN=Scancode
  915.       Until I$<>""
  916.       Fade 1 : For A=0 To 16 : Multi Wait : Next 
  917.       Screen Close 7
  918.       If SCAN<>95
  919.         QUIT
  920.         End 
  921.       Else 
  922.         Kill "Tubes.Sav"
  923.         SG=0 : Erase 17
  924.       End If 
  925.     End If 
  926.   Else 
  927.     SG=0
  928.   End If 
  929. End Proc
  930. Procedure REBUILDGFX
  931.   Shared LEVEL
  932.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  933.   NEWTUBCOL
  934.   Cls 0
  935.   Screen Copy 1,0,16,320,80 To 0,0,0
  936.    Extension_8_1204 10
  937.   TB=Text Base
  938.   Ink 15,0 : Set Pattern -1
  939.   Bar 0,64 To 320,256
  940.   Put Block 6,0,64 : Put Block 6,15*16,64
  941.   Put Block 7,14*16,64 : Put Block 7,304,64
  942.   Put Block 8,0,240 : Put Block 8,15*16,240
  943.   Put Block 9,14*16,240 : Put Block 9,304,240
  944.   For A=1 To 13
  945.     Put Block 3,A*16,64
  946.     Put Block 3,A*16,240
  947.     If A<4
  948.       Put Block 3,A*16+15*16,64
  949.       Put Block 3,A*16+15*16,240
  950.     End If 
  951.   Next 
  952.   For A=5 To 14
  953.     Put Block 2,0,A*16
  954.     Put Block 2,14*16,A*16
  955.     Put Block 2,15*16,A*16
  956.     Put Block 2,304,A*16
  957.   Next 
  958.   Limit Mouse X Hard(16),Y Hard(80) To X Hard(14*16-1),Y Hard(15*16-1)
  959.   Screen 2
  960.    Extension_8_1204 11 : TB=Text Base
  961.    Extension_8_121C 2,0
  962.   T[128,"Get ready for Level"+Str$(LEVEL)]
  963.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  964.    Extension_8_128A 2
  965.    Extension_8_12B2 2,0 To 0,3
  966.    Extension_8_1258 : Wait Vbl 
  967.   For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  968.   Fade 1 To 2
  969.   For A=1 To 50 : Multi Wait : Next 
  970.   Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  971.   Fade 1 To 2
  972.   For A=1 To 32 : Multi Wait : Next 
  973.    Extension_8_121C 0,3
  974.   Fade 2 To 1
  975. End Proc
  976. Procedure REBUILDGFXSAVEGAME[SGAD]
  977.   Shared NUMTUBES,LEVEL,SCORE,TIME,LEVDIF,MUS,SOU
  978.   Shared WX,WY,SX,SY
  979.   Shared DISA,LIQ,CURVSAM,CURVFREQ
  980.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  981.   Cls 0
  982.   Screen Copy 1,0,16,320,80 To 0,0,0
  983.    Extension_8_1204 10
  984.   TB=Text Base
  985.   Ink 15,0 : Set Pattern -1
  986.   Bar 0,64 To 320,256
  987.   Put Block 6,0,64 : Put Block 6,15*16,64
  988.   Put Block 7,14*16,64 : Put Block 7,304,64
  989.   Put Block 8,0,240 : Put Block 8,15*16,240
  990.   Put Block 9,14*16,240 : Put Block 9,304,240
  991.   For A=1 To 13
  992.     Put Block 3,A*16,64
  993.     Put Block 3,A*16,240
  994.     If A<4
  995.       Put Block 3,A*16+15*16,64
  996.       Put Block 3,A*16+15*16,240
  997.     End If 
  998.   Next 
  999.   For A=5 To 14
  1000.     Put Block 2,0,A*16
  1001.     Put Block 2,14*16,A*16
  1002.     Put Block 2,15*16,A*16
  1003.     Put Block 2,304,A*16
  1004.   Next 
  1005.   Limit Mouse X Hard(16),Y Hard(80) To X Hard(14*16-1),Y Hard(15*16-1)
  1006.   SEARCHCHUNK[SGAD,"ENVI"]
  1007.   ADR=Param+16
  1008.   MUS= Extension_8_0BE4(ADR) : SOU= Extension_8_0BE4(ADR+2) : LIQ= Extension_8_0BE4(ADR+4) : Add ADR,6
  1009.   If DISA : MUS=0 : SOU=0 : End If 
  1010.   CURVSAM=Deek(ADR) : CURVFREQ=Leek(ADR+2) : Add ADR,6
  1011.   X Mouse=Deek(ADR) : Y Mouse=Deek(ADR+2) : Add ADR,4
  1012.   Screen 2
  1013.   For A=0 To 31
  1014.     Colour A,Deek(ADR) : Add ADR,2
  1015.   Next 
  1016.   Screen 1 : Get Palette 2
  1017.   Screen 0
  1018.   SEARCHCHUNK[SGAD,"RAND"]
  1019.   ADR=Param
  1020.    Extension_8_026E ADR+8,ADR+8+Leek(ADR+4) To 16
  1021.   SEARCHCHUNK[SGAD,"GMAP"]
  1022.   ADR=Param+8
  1023.   For Y=0 To 9
  1024.     For X=0 To 12
  1025.       F(X,Y)= Extension_8_0BE4(ADR) : Add ADR,2
  1026.       Put Block Abs(F(X,Y))+1,X*16+16,Y*16+80
  1027.     Next 
  1028.   Next 
  1029.   SEARCHCHUNK[SGAD,"VARS"]
  1030.   ADR=Param+8
  1031.   LEVEL=Deek(ADR) : SCORE=Deek(ADR+2) : NUMTUBES=Deek(ADR+4) : Add ADR,6
  1032.   REPART=Deek(ADR) : LEVDIF=Deek(ADR+2) : TIME=Deek(ADR+4) : Add ADR,6
  1033.   RETIME=Deek(ADR) : ST=Start(16)+Leek(ADR+2) : Add ADR,6
  1034.   HOM=Deek(ADR) : WX= Extension_8_0BE4(ADR+2) : WY= Extension_8_0BE4(ADR+4) : SX= Extension_8_0BE4(ADR+6) : SY= Extension_8_0BE4(ADR+8) : Add ADR,10
  1035.   TIE=Deek(ADR) : TIE2=Deek(ADR+2) : TIE3=Deek(ADR+4) : TIE4=Deek(ADR+6)
  1036.   Put Block HOM+1,SX*16+16,SY*16+80
  1037.   Screen 2
  1038.    Extension_8_1204 11 : TB=Text Base
  1039.    Extension_8_121C 2,0
  1040.   T[128,"Restarting Level"+Str$(LEVEL)]
  1041.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  1042.    Extension_8_128A 2
  1043.    Extension_8_12B2 2,0 To 0,3
  1044.    Extension_8_1258 : Wait Vbl 
  1045.   For A=0 To 7 : Colour A+8,$FFF : Next : Screen 0
  1046.   Fade 1 To 2
  1047.   For A=1 To 50 : Multi Wait : Next 
  1048.   Screen 2 : For A=0 To 7 : Colour A+8,Colour(A) : Next : Screen 0
  1049.   Fade 1 To 2
  1050.   For A=1 To 32 : Multi Wait : Next 
  1051.    Extension_8_121C 0,3
  1052.   Fade 2 To 1
  1053. End Proc
  1054. Procedure SHUFFLEBONUSGAME
  1055.   Shared NUMTUBES,SCORE,LEVEL,TIME,MUS,SOU,DISA
  1056.   Shared WX,WY,SX,SY
  1057.   NEWRND[13*10]
  1058.   NUMTUBES=1
  1059.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  1060.   NEWTUBCOL
  1061.   Cls 0
  1062.   Screen Copy 1,0,16,320,80 To 0,0,0
  1063.    Extension_8_1204 10
  1064.   TB=Text Base
  1065.   Ink 15,0 : Set Pattern -1
  1066.   Bar 0,64 To 320,256
  1067.   Put Block 6,0,64 : Put Block 6,15*16,64
  1068.   Put Block 7,14*16,64 : Put Block 7,304,64
  1069.   Put Block 8,0,240 : Put Block 8,15*16,240
  1070.   Put Block 9,14*16,240 : Put Block 9,304,240
  1071.   For A=1 To 13
  1072.     Put Block 3,A*16,64
  1073.     Put Block 3,A*16,240
  1074.     If A<4
  1075.       Put Block 3,A*16+15*16,64
  1076.       Put Block 3,A*16+15*16,240
  1077.     End If 
  1078.   Next 
  1079.   For A=5 To 14
  1080.     Put Block 2,0,A*16
  1081.     Put Block 2,14*16,A*16
  1082.     Put Block 2,15*16,A*16
  1083.     Put Block 2,304,A*16
  1084.   Next 
  1085.   ST=Start(16)
  1086.   For Y=0 To 9
  1087.     For X=0 To 12
  1088.       F(X,Y)=Peek(ST) : Inc ST
  1089.       Put Block F(X,Y)+1,X*16+16,Y*16+80
  1090.     Next 
  1091.   Next 
  1092.   Limit Mouse X Hard(-4),Y Hard(80) To X Hard(279),Y Hard(15*16-1)
  1093.   Screen 2
  1094.    Extension_8_1204 11 : TB=Text Base
  1095.    Extension_8_121C 2,0
  1096.   T[112,"Get ready for"]
  1097.   T[144,"Bonus Level"]
  1098.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  1099.    Extension_8_128A 2
  1100.    Extension_8_12B2 2,0 To 0,3
  1101.    Extension_8_1258 : Wait Vbl 
  1102.    Extension_8_1486 0,2
  1103.   For A=0 To 7 : Colour A+8,$FFF : Next 
  1104.   For A=0 To 7 : Colour A,0 : Next : Screen 0
  1105.   Fade 1 To 2
  1106.   For A=1 To 50 : Multi Wait : Next 
  1107.    Extension_8_149E 0,2
  1108.   Screen 1
  1109.   Colour 17,0 : Colour 18,$EE0 : Colour 19,$E70
  1110.   Colour 20,$A50 : Colour 21,$530
  1111.    Extension_8_1486 0,1
  1112.   For A=0 To 7 : Colour A+8,Colour(A) : Next 
  1113.   Screen 0
  1114.   Fade 2 To 1
  1115.   For A=1 To 32 : Multi Wait : Next 
  1116.    Extension_8_149E 0,1
  1117.    Extension_8_121C 0,3 : Multi Wait 
  1118.   Get Palette 1
  1119.   If MUS
  1120.      Extension_8_10C6 64
  1121.      Extension_8_109E 3,19
  1122.   End If 
  1123.   SX=Rnd(10)+1
  1124.   SY=Rnd(7)+1
  1125.   HOM=Rnd(3)+9
  1126.   Ink 15,0 : Set Pattern -1 : Bar SX*16+16,SY*16+80 To SX*16+31,SY*16+95
  1127.   Put Block HOM+1,SX*16+16,SY*16+80
  1128.   F(SX,SY)=HOM
  1129.   If HOM=9 Then WX=0 : WY=1
  1130.   If HOM=10 Then WX=0 : WY=-1
  1131.   If HOM=11 Then WX=1 : WY=0
  1132.   If HOM=12 Then WX=-1 : WY=0
  1133.   Gr Writing 0
  1134.   Ink 1,0
  1135.   Text 260,80+TB,"Bonus"
  1136.   Text 260,88+TB,"Level"
  1137.   Text 260,104+TB,"Score"
  1138.   Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  1139.   Text 260,128+TB,"Time:"
  1140.   Timer=0
  1141.   Gr Writing 1
  1142.   Do 
  1143.     Clear Key 
  1144.     Repeat 
  1145.       T=TIME-(Timer/50)
  1146.       If OT<>T
  1147.         T1=T/60 : T2=T mod 60
  1148.         DUMMY$=Str$(T1)+Str$(T2)
  1149.         OT=T
  1150.         Ink 1,0 : Text 260,136+TB, Extension_8_0EB8(T1,2)+":"+ Extension_8_0EB8(T2,2)
  1151.         Exit If T=0,2
  1152.         If SOU
  1153.           If T>10
  1154.              Extension_8_13EA Extension_8_04F8(VO),16 : Add VO,1,MUS*2 To 3
  1155.           Else 
  1156.              Extension_8_13F4 Extension_8_04F8(VO),14,8000 : Add VO,1,MUS*2 To 3
  1157.           End If 
  1158.         End If 
  1159.       End If 
  1160.       Multi Wait 
  1161.       MK=Mouse Key
  1162.       I$=Lower$(Inkey$)
  1163.       Gosub MOUSPOS
  1164.       If I$="s" and DISA=0
  1165.         SOU=1-SOU
  1166.         If SOU=0
  1167.            Extension_8_1400 15
  1168.         End If 
  1169.       End If 
  1170.       If I$="m" and DISA=0
  1171.         MUS=1-MUS
  1172.         If MUS=0
  1173.            Extension_8_10A8 
  1174.         Else 
  1175.            Extension_8_109E 3,19
  1176.         End If 
  1177.       End If 
  1178.       If I$="p"
  1179.         Fade 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1180.         TT=Timer
  1181.         If MUS
  1182.           P=Peek( Extension_8_1386 -12)
  1183.            Extension_8_109E 3,50
  1184.         End If 
  1185.         Repeat 
  1186.           Multi Wait 
  1187.           MK=Mouse Key : Gosub MOUSPOS
  1188.           Sprite 0,X Hard(XM*16+16),Y Hard(YM*16+80),TIE+36
  1189.         Until Inkey$<>"" or MK>0 or Fire(1)<>0
  1190.         Repeat 
  1191.           Multi Wait 
  1192.           MK=Mouse Key
  1193.         Until MK=0 or Fire(1)<>0
  1194.         If MUS
  1195.            Extension_8_10A8 : Extension_8_109E 3,P
  1196.         End If 
  1197.         Fade 1 To 1
  1198.         Timer=TT
  1199.       End If 
  1200.       Exit If I$=Chr$(27),2
  1201.       Sprite 0,X Hard(XM*16+16),Y Hard(YM*16+80),TIE+36
  1202.     Until MK
  1203.     If(TIE=0 and MK=1) or(TIE=2 and MK=2)
  1204.       If SOU
  1205.          Extension_8_13EA Extension_8_04F8(VO),24 : Add VO,1,MUS*2 To 3
  1206.       End If 
  1207.       Screen Copy 0,XM*16+16,224,XM*16+32,240 To 1,304,0
  1208.       For A=0 To 15
  1209.         Screen Copy 0,XM*16+16,80,XM*16+32,239 To 0,XM*16+16,81
  1210.         Screen Copy 1,304,15-A,320,16-A To 0,XM*16+16,80
  1211.         If A<>15 : Multi Wait : End If 
  1212.       Next 
  1213.       AA=F(XM,9)
  1214.       For A=8 To 0 Step -1 : F(XM,A+1)=F(XM,A) : Next 
  1215.       F(XM,0)=AA
  1216.       If XM=SX : Add SY,1,0 To 9 : End If 
  1217.     End If 
  1218.     If(TIE=0 and MK=2) or(TIE=2 and MK=1)
  1219.       If SOU
  1220.          Extension_8_13EA Extension_8_04F8(VO),24 : Add VO,1,MUS*2 To 3
  1221.       End If 
  1222.       Screen Copy 0,XM*16+16,80,XM*16+32,96 To 1,304,0
  1223.       For A=0 To 15
  1224.         Screen Copy 0,XM*16+16,81,XM*16+32,240 To 0,XM*16+16,80
  1225.         Screen Copy 1,304,A,320,A+1 To 0,XM*16+16,239
  1226.         If A<>15 : Multi Wait : End If 
  1227.       Next 
  1228.       AA=F(XM,0)
  1229.       For A=1 To 9 : F(XM,A-1)=F(XM,A) : Next 
  1230.       F(XM,9)=AA
  1231.       If XM=SX : Add SY,-1,0 To 9 : End If 
  1232.     End If 
  1233.     If(TIE=1 and MK=1) or(TIE=3 and MK=2)
  1234.       If SOU
  1235.          Extension_8_13EA Extension_8_04F8(VO),24 : Add VO,1,MUS*2 To 3
  1236.       End If 
  1237.       Screen Copy 0,16,YM*16+80,32,YM*16+96 To 1,304,0
  1238.       For A=0 To 15
  1239.         Screen Copy 0,17,YM*16+80,224,YM*16+96 To 0,16,YM*16+80
  1240.         Screen Copy 1,304+A,0,305+A,16 To 0,223,YM*16+80
  1241.         If A<>15 : Multi Wait : End If 
  1242.       Next 
  1243.       AA=F(0,YM)
  1244.       For A=0 To 11 : F(A,YM)=F(A+1,YM) : Next 
  1245.       F(12,YM)=AA
  1246.       If YM=SY : Add SX,-1,0 To 12 : End If 
  1247.     End If 
  1248.     If(TIE=1 and MK=2) or(TIE=3 and MK=1)
  1249.       If SOU
  1250.          Extension_8_13EA Extension_8_04F8(VO),24 : Add VO,1,MUS*2 To 3
  1251.       End If 
  1252.       Screen Copy 0,208,YM*16+80,224,YM*16+96 To 1,304,0
  1253.       For A=0 To 15
  1254.         Screen Copy 0,16,YM*16+80,223,YM*16+96 To 0,17,YM*16+80
  1255.         Screen Copy 1,319-A,0,320-A,16 To 0,16,YM*16+80
  1256.         If A<>15 : Multi Wait : End If 
  1257.       Next 
  1258.       AA=F(12,YM)
  1259.       For A=12 To 1 Step -1 : F(A,YM)=F(A-1,YM) : Next 
  1260.       F(0,YM)=AA
  1261.       If YM=SY : Add SX,1,0 To 12 : End If 
  1262.     End If 
  1263.   Loop 
  1264.   Sprite Off 
  1265.   TIME=0 : If MUS Then Extension_8_10A8 
  1266. Pop Proc
  1267. MOUSPOS:
  1268.   X=X Screen(X Mouse)
  1269.   If I$=Cleft$ Then X Mouse=X Hard((X+270) mod 276)
  1270.   If I$=Cright$ Then X Mouse=X Hard((X+6) mod 276)
  1271.   If Jleft(1) Then X Mouse=X Hard((X+275) mod 276)
  1272.   If Jright(1) Then X Mouse=X Hard((X+1) mod 276)
  1273.   If I$=Cup$ or Jup(1)<>0 Then MK=1
  1274.   If I$=Cdown$ or Jdown(1)<>0 Then MK=2
  1275.   If X<0 Then X Mouse=X Hard(X)+276
  1276.   If X>275 Then X Mouse=X Hard(X)-276
  1277.   X=X Screen(X Mouse)
  1278.   MP=(X Screen(X Mouse))/6
  1279.   If MP<13 Then XM=MP : YM=-1 : TIE=0
  1280.   If MP>12 and MP<23 Then XM=13 : YM=MP-13 : TIE=1
  1281.   If MP>22 and MP<36 Then XM=35-MP : YM=10 : TIE=2
  1282.   If MP>35 Then XM=-1 : YM=45-MP : TIE=3
  1283. Return 
  1284. End Proc
  1285. Procedure TETRISBONUS
  1286.   Shared NUMTUBES,SCORE,LEVEL,TIME,MUS,SOU,DISA
  1287.   Shared WX,WY,SX,SY
  1288.   On Error Goto ERRHANDLING
  1289.   NEWRND[NUMTUBES]
  1290.   Fade 1 : For A=0 To 15 : Multi Wait : Next 
  1291.   NEWTUBCOL
  1292.   Cls 0
  1293.   Screen Copy 1,0,16,320,80 To 0,0,0
  1294.    Extension_8_1204 10
  1295.   TB=Text Base
  1296.   Ink 15,0 : Set Pattern -1
  1297.   Bar 0,64 To 320,256
  1298.   Put Block 6,0,64 : Put Block 6,15*16,64
  1299.   Put Block 7,14*16,64 : Put Block 7,304,64
  1300.   Put Block 8,0,240 : Put Block 8,15*16,240
  1301.   Put Block 9,14*16,240 : Put Block 9,304,240
  1302.   For A=1 To 13
  1303.     Put Block 3,A*16,64
  1304.     Put Block 3,A*16,240
  1305.     If A<4
  1306.       Put Block 3,A*16+15*16,64
  1307.       Put Block 3,A*16+15*16,240
  1308.     End If 
  1309.   Next 
  1310.   For A=5 To 14
  1311.     Put Block 2,0,A*16
  1312.     Put Block 2,14*16,A*16
  1313.     Put Block 2,15*16,A*16
  1314.     Put Block 2,304,A*16
  1315.   Next 
  1316.   For Y=0 To 9
  1317.     For X=0 To 12
  1318.       F(X,Y)=-(Y=9)*10
  1319.     Next 
  1320.   Next 
  1321.   SY=9 : HOM=10
  1322.   For SX=0 To 12
  1323.     Put Block HOM+1,SX*16+16,SY*16+80
  1324.   Next 
  1325.   Gr Writing 0
  1326.   Ink 1,0
  1327.   Text 260,80+TB,"Bonus"
  1328.   Text 260,88+TB,"Level"
  1329.   Text 260,104+TB,"Score"
  1330.   Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  1331.   Text 260,128+TB,"Time:"
  1332.   Limit Mouse X Hard(16),Y Hard(80) To X Hard(14*16-1),Y Hard(15*16-1)
  1333.   Screen 2
  1334.    Extension_8_1204 11 : TB=Text Base
  1335.    Extension_8_121C 2,0
  1336.   T[112,"Get ready for"]
  1337.   T[144,"Bonus Level"]
  1338.   Screen 2 : Extension_8_1204 10 : TB=Text Base
  1339.    Extension_8_128A 2
  1340.    Extension_8_12B2 2,0 To 0,3
  1341.    Extension_8_1258 : Wait Vbl 
  1342.    Extension_8_1486 0,2
  1343.   For A=0 To 7 : Colour A+8,$FFF : Next 
  1344.   For A=0 To 7 : Colour A,0 : Next : Screen 0
  1345.   Fade 1 To 2
  1346.   For A=1 To 50 : Multi Wait : Next 
  1347.    Extension_8_149E 0,2
  1348.    Extension_8_1486 0,1
  1349.   Screen 1 : For A=0 To 7 : Colour A+8,Colour(A) : Next 
  1350.   Screen 0
  1351.   Fade 2 To 1
  1352.   For A=1 To 32 : Multi Wait : Next 
  1353.    Extension_8_149E 0,1
  1354.    Extension_8_121C 0,3 : Multi Wait 
  1355.   For A=0 To 7 : Colour A+8,Colour(A) : Next 
  1356.   For SX=0 To 12
  1357.     Put Block HOM+1,SX*16+16,SY*16+80
  1358.   Next 
  1359.   Fade 1 To 1 : For A=1 To 16 : Multi Wait : Next 
  1360.   If MUS
  1361.      Extension_8_10C6 64
  1362.      Extension_8_109E 3,19
  1363.   End If 
  1364.   ST=Start(16)
  1365.   TIE2=Peek(ST) : Inc ST
  1366.   TIE3=Peek(ST) : Inc ST
  1367.   TIE4=Peek(ST) : Inc ST
  1368.   Timer=0
  1369.   VO=2
  1370.   Gr Writing 1
  1371.   For PARTS=1 To NUMTUBES
  1372.     Ink 1,0 : Text 260,160+TB, Extension_8_0EB8(Min(PARTS,99),2)+"/"+ Extension_8_0EB8(Min(NUMTUBES,99),2)
  1373.     TIE=TIE2 : TIE2=TIE3 : TIE3=TIE4
  1374.     If PARTS<NUMTUBES-2 Then TIE4=Peek(ST) : Inc ST Else TIE4=0
  1375.     Ink 15,0 : Set Pattern -1 : Bar 256,224 To 303,239
  1376.     If LEVEL<15 Then Put Block TIE2+1,256,224 Else Put Block 1,256,224
  1377.     If LEVEL<10 Then Put Block TIE3+1,272,224 Else Put Block 1,272,224
  1378.     If LEVEL<5 Then Put Block TIE4+1,288,224 Else Put Block 1,288,224
  1379.     TX=6*16 : TY=-16
  1380.     X Mouse=X Hard(TX+24)
  1381.     DTRIGGER=0
  1382.     Do 
  1383.       Multi Wait 
  1384.       T=TIME-(Timer/50)
  1385.       If OT<>T
  1386.         T1=T/60 : T2=T mod 60
  1387.         DUMMY$=Str$(T1)+Str$(T2)
  1388.         OT=T
  1389.         Ink 1,0 : Text 260,136+TB, Extension_8_0EB8(T1,2)+":"+ Extension_8_0EB8(T2,2)
  1390.         Exit If T=0,2
  1391.         If SOU
  1392.           If T>10
  1393.              Extension_8_13EA Extension_8_04F8(VO),16 : Add VO,1,MUS*2 To 3
  1394.           Else 
  1395.              Extension_8_13F4 Extension_8_04F8(VO),14,8000 : Add VO,1,MUS*2 To 3
  1396.           End If 
  1397.         End If 
  1398.       End If 
  1399.       D=Jleft(1)-Jright(1)
  1400.       If D<>0 Then X Mouse=X Mouse+D*2
  1401.       XM=(X Screen(X Mouse)-16)/16
  1402.       MK=Mouse Key
  1403.       Exit If MK=2,2
  1404.       I$=Lower$(Inkey$)
  1405.       If I$=Cleft$ and XM>0 Then X Mouse=X Hard(XM*16+8) : Dec XM : DTRIGGER=0
  1406.       If I$=Cright$ and XM<12 Then X Mouse=X Hard(XM*16+40) : Inc XM : DTRIGGER=0
  1407.       If I$=" " or I$=Cdown$ Then DTRIGGER=-1
  1408.       If I$="s" and DISA=0
  1409.         SOU=1-SOU
  1410.         If SOU=0
  1411.            Extension_8_1400 15
  1412.         End If 
  1413.       End If 
  1414.       If I$="m" and DISA=0
  1415.         MUS=1-MUS
  1416.         If MUS=0
  1417.            Extension_8_10A8 
  1418.         Else 
  1419.            Extension_8_109E 3,19
  1420.         End If 
  1421.       End If 
  1422.       If I$="p"
  1423.         Fade 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1424.         TT=Timer
  1425.         If MUS
  1426.           P=Peek( Extension_8_1386 -12)
  1427.            Extension_8_109E 3,50
  1428.         End If 
  1429.         Repeat 
  1430.           Multi Wait 
  1431.         Until Inkey$<>"" or MK>0 or Fire(1)<>0
  1432.         Repeat 
  1433.           Multi Wait 
  1434.           MK=Mouse Key
  1435.         Until MK=0 or Fire(1)<>0
  1436.         If MUS
  1437.            Extension_8_10A8 : Extension_8_109E 3,P
  1438.         End If 
  1439.         Fade 1 To 1
  1440.         Timer=TT
  1441.       End If 
  1442.       Exit If I$=Chr$(27),2
  1443.       BX=TX/16 : BY=(TY-80)/16
  1444.       If BY>-2
  1445.         Exit If F(BX,BY+1)<>0
  1446.       End If 
  1447.       D=Sgn(XM*16-TX)
  1448.       ACC=(MK=1) or Fire(1) or Jdown(1) or DTRIGGER
  1449.       If ACC and TY>0 Then TY=(TY and $FFC)+4 : TX=TX and $FFC
  1450.       If D and BY>-2
  1451.         If F(Max(Min(BX+D,12),0),BY+1)=0
  1452.           Add TX,D*(2-ACC*2)
  1453.           If F(BX,BY+2)=0
  1454.             Inc TY
  1455.           End If 
  1456.         Else 
  1457.           Add TX,Sgn(BX*16-TX)
  1458.           Inc TY
  1459.         End If 
  1460.       Else 
  1461.         Inc TY
  1462.         Add TX,D*(2-ACC*2)
  1463.       End If 
  1464.       Sprite 0,X Hard(TX+16),Y Hard(TY),TIE+1
  1465.       Sprite 2,X Hard(XM*16+16),Y Hard(TY),TIE+1
  1466.     Loop 
  1467.     Exit If BY=-1
  1468.     F(BX,BY)=TIE : Put Block TIE+1,BX*16+16,BY*16+80
  1469.     If SOU
  1470.        Extension_8_13F4 Extension_8_04F8(VO),15,10000 : Add VO,1,MUS*2 To 3
  1471.     End If 
  1472.   Next 
  1473.   Sprite Off 
  1474.   If MUS Then Extension_8_10A8 
  1475.   For A=0 To 12
  1476.     TIME=0 : WX=0 : WY=-1 : SX=A : SY=9 : HOM=10
  1477.     WATERGO
  1478.     For Y=0 To 9
  1479.       For X=0 To 12
  1480.         F(X,Y)=Abs(F(X,Y))
  1481.       Next 
  1482.     Next 
  1483.   Next 
  1484. Pop Proc
  1485. ERRHANDLING:
  1486. Resume Next 
  1487. End Proc
  1488. Procedure SETTUBES[SGAD]
  1489.   Shared NUMTUBES,LEVEL,SCORE,TIME,LEVDIF,MUS,SOU
  1490.   Shared WX,WY,SX,SY
  1491.   On Error Goto ERRHANDLING
  1492.   If SGAD
  1493.     SEARCHCHUNK[SGAD,"VARS"]
  1494.     ADR=Param+8
  1495.     LEVEL=Deek(ADR) : SCORE=Deek(ADR+2) : NUMTUBES=Deek(ADR+4) : Add ADR,6
  1496.     REPART=Deek(ADR) : LEVDIF=Deek(ADR+2) : TIME=Deek(ADR+4) : Add ADR,6
  1497.     RETIME=Deek(ADR) : ST=Start(16)+Leek(ADR+2) : Add ADR,6
  1498.     HOM=Deek(ADR) : WX= Extension_8_0BE4(ADR+2) : WY= Extension_8_0BE4(ADR+4) : SX= Extension_8_0BE4(ADR+6) : SY= Extension_8_0BE4(ADR+8) : Add ADR,10
  1499.     TIE=Deek(ADR) : TIE2=Deek(ADR+2) : TIE3=Deek(ADR+4) : TIE4=Deek(ADR+6)
  1500.     Put Block HOM+1,SX*16+16,SY*16+80
  1501.   Else 
  1502.     REPART=1
  1503.     RETIME=TIME
  1504.     NEWRND[NUMTUBES]
  1505.     For Y=0 To 9
  1506.       For X=0 To 12
  1507.         F(X,Y)=0
  1508.       Next 
  1509.     Next 
  1510.     SX=Rnd(10)+1
  1511.     SY=Rnd(7)+1
  1512.     HOM=Rnd(3)+9
  1513.     Put Block HOM+1,SX*16+16,SY*16+80
  1514.     F(SX,SY)=HOM
  1515.     If LEVEL>2
  1516.       For A=1 To Min(LEVEL/2,10)
  1517.         Repeat 
  1518.           X=Rnd(10)+1
  1519.           Y=Rnd(7)+1
  1520.         Until F(X,Y)=0 and F(X-1,Y)=0 and F(X+1,Y)=0 and F(X,Y-1)=0 and F(X,Y+1)=0
  1521.         F=Rnd(7)+1
  1522.         Put Block F+1,X*16+16,Y*16+80
  1523.         F(X,Y)=-F
  1524.       Next 
  1525.     End If 
  1526.     If HOM=9 : WX=0 : WY=1 : End If 
  1527.     If HOM=10 : WX=0 : WY=-1 : End If 
  1528.     If HOM=11 : WX=1 : WY=0 : End If 
  1529.     If HOM=12 : WX=-1 : WY=0 : End If 
  1530.     ST=Start(16)
  1531.     TIE2=Peek(ST) : Inc ST
  1532.     TIE3=Peek(ST) : Inc ST
  1533.     TIE4=Peek(ST) : Inc ST
  1534.   End If 
  1535.   Gr Writing 0
  1536.   Ink 1,0
  1537.   Text 260,80+TB,"Level"
  1538.   Text 272,88+TB, Extension_8_0EB8(LEVEL,2)
  1539.   Text 260,104+TB,"Score"
  1540.   Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  1541.   Text 260,128+TB,"Time:"
  1542.   Text 260,152+TB,"Tubes"
  1543.   Text 260,216+TB,"Next:"
  1544.   If MUS
  1545.      Extension_8_10C6 64
  1546.      Extension_8_109E 3,19
  1547.   End If 
  1548.   Timer=(TIME-RETIME)*50
  1549.   For PARTS=REPART To NUMTUBES
  1550.     Gr Writing 1
  1551.     If SGAD=0 or PARTS<>REPART
  1552.       TIE=TIE2
  1553.       TIE2=TIE3
  1554.       TIE3=TIE4
  1555.       If PARTS<NUMTUBES-2
  1556.         TIE4=Peek(ST) : Inc ST
  1557.       Else 
  1558.         TIE4=0
  1559.       End If 
  1560.     End If 
  1561.     Ink 1,0 : Text 260,160+TB, Extension_8_0EB8(Min(PARTS,99),2)+"/"+ Extension_8_0EB8(Min(NUMTUBES,99),2)
  1562.     Ink 15,0 : Set Pattern -1 : Bar 256,224 To 303,239
  1563.     If LEVEL<15 Then Put Block TIE2+1,256,224 Else Put Block 1,256,224
  1564.     If LEVEL<10 Then Put Block TIE3+1,272,224 Else Put Block 1,272,224
  1565.     If LEVEL<5 Then Put Block TIE4+1,288,224 Else Put Block 1,288,224
  1566.     JOOLD=0
  1567.     Repeat 
  1568.       T=TIME-(Timer/50)
  1569.       If OT<>T
  1570.         T1=T/60 : T2=T mod 60
  1571.         DUMMY$=Str$(T1)+Str$(T2)
  1572.         OT=T
  1573.         Ink 1,0 : Text 260,136+TB, Extension_8_0EB8(T1,2)+":"+ Extension_8_0EB8(T2,2)
  1574.         Exit If T=0,2
  1575.         If T>10
  1576.           If SOU
  1577.              Extension_8_13EA Extension_8_04F8(VO),16 : Add VO,1,MUS*2 To 3
  1578.           End If 
  1579.         Else 
  1580.           If T=10 and MUS=1
  1581.              Extension_8_109E 3,28
  1582.           End If 
  1583.           If SOU
  1584.              Extension_8_13F4 8,14,8000 : VO=MUS*2
  1585.           End If 
  1586.         End If 
  1587.       End If 
  1588.       Multi Wait 
  1589.       MK=Mouse Key
  1590.       XM=(X Screen(X Mouse)-16)/16
  1591.       YM=(Y Screen(Y Mouse)-80)/16
  1592.       I$=Lower$(Inkey$) : SCAN=Scancode
  1593.       If I$="s" and DISA=0
  1594.         SOU=1-SOU
  1595.         If SOU=0
  1596.            Extension_8_1400 15
  1597.         End If 
  1598.       End If 
  1599.       If I$="m" and DISA=0
  1600.         MUS=1-MUS
  1601.         If MUS=0
  1602.            Extension_8_10A8 
  1603.         Else 
  1604.            Extension_8_109E 3,19
  1605.         End If 
  1606.       End If 
  1607.       If Joy(1)<>JOOLD or I$<>""
  1608.         If I$=Cleft$ or Jleft(1) : X Mouse=X Hard(XM*16+8) : End If 
  1609.         If I$=Cright$ or Jright(1) : X Mouse=X Hard(XM*16+40) : End If 
  1610.         If I$=Cup$ or Jup(1) : Y Mouse=Y Hard(YM*16+72) : End If 
  1611.         If I$=Cdown$ or Jdown(1) : Y Mouse=Y Hard(YM*16+104) : End If 
  1612.         If I$=" " or Fire(1) : MK=1 : End If 
  1613.         JOOLD=Joy(1)
  1614.       End If 
  1615.       If SCAN=70 Then MK=2
  1616.       If I$="p"
  1617.         TT=Timer
  1618.         Fade 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1619.         If MUS
  1620.           P=Peek( Extension_8_1386 -12)
  1621.            Extension_8_109E 3,50
  1622.         End If 
  1623.         Repeat 
  1624.           Multi Wait 
  1625.           MK=Mouse Key
  1626.           XM=(X Screen(X Mouse)-16)/16
  1627.           YM=(Y Screen(Y Mouse)-80)/16
  1628.           Sprite 0,X Hard(XM*16+16),Y Hard(YM*16+80),TIE+1
  1629.         Until Inkey$<>"" or MK>0 or Fire(1)<>0
  1630.         Repeat 
  1631.           Multi Wait 
  1632.           MK=Mouse Key
  1633.         Until MK=0 and Fire(1)=0
  1634.         If MUS
  1635.            Extension_8_10A8 : Extension_8_109E 3,P
  1636.         End If 
  1637.         Fade 1 To 1
  1638.         Timer=TT
  1639.       End If 
  1640.       Exit If I$=Chr$(27),2
  1641.       Sprite 0,X Hard(XM*16+16),Y Hard(YM*16+80),TIE+1
  1642.       If F(XM,YM)<>0 and MK=1
  1643.         If SOU
  1644.            Extension_8_13F4 Extension_8_04F8(VO),4,9000 : Add VO,1,MUS*2 To 3
  1645.         End If 
  1646.         Repeat 
  1647.           Multi Wait 
  1648.           MK=Mouse Key
  1649.         Until MK=0 and Fire(1)=0
  1650.       End If 
  1651.       If MK=2 and T>15
  1652.         If F(XM,YM)<>0
  1653.           If Abs(F(XM,YM))<9
  1654.             If SOU
  1655.                Extension_8_13F4 Extension_8_04F8(VO),23,9000 : Add VO,1,MUS*2 To 3
  1656.             End If 
  1657.             Sprite Off 0
  1658.             Colour 29,$FF0 : Colour 30,$D70 : Colour 31,$C00
  1659.             For A=0 To 21
  1660.               Sprite 6,X Hard(XM*16+16),Y Hard(YM*16+80),14+A
  1661.               If A=13
  1662.                 Ink 15,0 : Set Pattern -1 : Bar XM*16+16,YM*16+80 To XM*16+31,YM*16+95
  1663.                 Put Block 1,XM*16+16,YM*16+80
  1664.               End If 
  1665.               Multi Wait 
  1666.             Next 
  1667.             Sprite Off 6
  1668.             F(XM,YM)=0
  1669.             Timer=Timer+250
  1670.           Else 
  1671.             If SOU
  1672.                Extension_8_13F4 Extension_8_04F8(VO),11,13000 : Add VO,1,MUS*2 To 3
  1673.             End If 
  1674.           End If 
  1675.         End If 
  1676.         Repeat 
  1677.           Multi Wait 
  1678.           MK=Mouse Key
  1679.         Until MK=0 and Fire(1)=0
  1680.       End If 
  1681.       If SCAN=95 and LEVEL<>0 Then Gosub SAVGAM
  1682.     Until MK=1
  1683.     If SOU
  1684.        Extension_8_13F4 Extension_8_04F8(VO),15,10000 : Add VO,1,MUS*2 To 3
  1685.     End If 
  1686.     F(XM,YM)=TIE
  1687.     Put Block TIE+1,XM*16+16,YM*16+80
  1688.     Sprite Off 
  1689.     Repeat 
  1690.       Multi Wait 
  1691.       MK=Mouse Key
  1692.     Until MK=0 and Fire(1)=0
  1693.   Next 
  1694.   Sprite Off 
  1695.   TIME=T : If MUS Then Extension_8_10A8 
  1696. Pop Proc
  1697. SAVGAM:
  1698.   Sprite Off 
  1699.   TT=Timer
  1700.   Screen Open 7,640,17,2,$8000
  1701.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  1702.   Palette 0,0
  1703.   Screen Display 7,128,164,320,16
  1704.   Centre "Do you really want to save the current game? (Y/N)" : Print 
  1705.   Centre "(The game will be quitted and you cannot play on for 10 minutes!)"
  1706.   Fade 1,0,$FFF : Multi Wait 
  1707.   Repeat 
  1708.     Multi Wait : I$=Lower$(Inkey$)
  1709.   Until I$="y" or I$="j" or I$="n"
  1710.   Fade 1 : For A=0 To 16 : Multi Wait : Next 
  1711.   Screen Close 7
  1712.   If I$="y" or I$="j"
  1713.     HED$=HED$+ Extension_8_08C4(LEVEL)+ Extension_8_08C4(SCORE)+ Extension_8_08C4(NUMTUBES)+ Extension_8_08C4(PARTS)
  1714.     HED$=HED$+ Extension_8_08C4(LEVDIF)+ Extension_8_08C4(TIME)+ Extension_8_08C4(TIME-(TT/50))
  1715.     HED$=HED$+ Extension_8_08D2(ST-Start(16))
  1716.     HED$=HED$+ Extension_8_08C4(HOM)+ Extension_8_08C4(WX)+ Extension_8_08C4(WY)+ Extension_8_08C4(SX)+ Extension_8_08C4(SY)
  1717.     HED$=HED$+ Extension_8_08C4(TIE)+ Extension_8_08C4(TIE2)+ Extension_8_08C4(TIE3)+ Extension_8_08C4(TIE4)
  1718.     SAVGAME[$100,HED$,%11]
  1719.     Sprite Off 
  1720.     If MUS : Extension_8_10A8 : End If 
  1721.     QUIT
  1722.     End 
  1723.   End If 
  1724.   Timer=TT
  1725. Return 
  1726. ERRHANDLING:
  1727. Resume Next 
  1728. End Proc
  1729. Procedure SEARCHCHUNK[SA,ID$]
  1730.   If Leek(SA)<> Extension_8_0998("FORM") Then Stop 
  1731.   If Leek(SA+8)<> Extension_8_0998("SAVE") Then Stop 
  1732.   EA=SA+Leek(SA+4)+8 : Add SA,12
  1733.   AD=0
  1734.   While SA<=EA
  1735.     LH=Leek(SA+4)
  1736.     If Leek(SA)= Extension_8_0998(ID$) Then AD=SA : Exit 
  1737.     Add SA,LH+8
  1738.   Wend 
  1739.   If AD=0 Then Stop 
  1740. End Proc[AD]
  1741. Procedure SAVGAME[MO,HEAD$,ARI]
  1742.   Shared MUS,SOU,LIQ,CURVSAM,CURVFREQ
  1743.   Open Out 1,"Tubes.Sav"
  1744.     Print #1,"FORM"+ Extension_8_08D2(0)+"SAVE";
  1745.     A$="ENVI"+ Extension_8_08D2(12*2+32*2)
  1746.     A$=A$+ Extension_8_08D2( Extension_8_07E0 )+ Extension_8_08D2( Extension_8_07CE )
  1747.     A$=A$+ Extension_8_08C4(MUS)+ Extension_8_08C4(SOU)+ Extension_8_08C4(LIQ)+ Extension_8_08C4(CURVSAM)+ Extension_8_08D2(CURVFREQ)
  1748.     A$=A$+ Extension_8_08C4(X Mouse)+ Extension_8_08C4(Y Mouse)
  1749.     For A=0 To 31
  1750.       A$=A$+ Extension_8_08C4(Colour(A))
  1751.     Next 
  1752.     Print #1,A$;
  1753.     Print #1,"MODE"+ Extension_8_08D2(4)+ Extension_8_08D2(MO);
  1754.     Print #1,"VARS"+ Extension_8_08D2(Len(HEAD$))+HEAD$;
  1755.     If ARI and 1
  1756.       A$="GMAP"+ Extension_8_08D2(13*10*2)
  1757.       For Y=0 To 9
  1758.         For X=0 To 12
  1759.           A$=A$+ Extension_8_08C4(F(X,Y))
  1760.         Next 
  1761.       Next 
  1762.       Print #1,A$;
  1763.     End If 
  1764.     If ARI and 2
  1765.       A$="RAND"+ Extension_8_08D2(Length(16))+Peek$(Start(16),Length(16))
  1766.       Print #1,A$;
  1767.     End If 
  1768.     L=Lof(1)
  1769.     Pof(1)=4 : Print #1, Extension_8_08D2(L-8);
  1770.   Close 1
  1771. End Proc
  1772. Procedure CLEANFIELDBONUS
  1773.   Shared SCORE,SOU,MUS,DISA
  1774.   NUMTUBES=0
  1775.   For Y=0 To 9
  1776.     For X=0 To 12
  1777.       If F(X,Y)>0 Then Inc NUMTUBES
  1778.     Next 
  1779.   Next 
  1780.   If NUMTUBES=0 Then Pop Proc
  1781.   Palette ,,,,,,,,,,,,,,,,,,,,,,,,$AAA,$333,$400,$EB0,$E80,$B60,$840,$A20
  1782.   For A=0 To 7 : Colour A+16,Colour(A) : Next 
  1783.   BAGDIR=Rnd(3)*4 : JOOLD=0
  1784.   Repeat 
  1785.     Multi Wait : I$=Inkey$
  1786.     XM=(X Screen(X Mouse)-16)/16
  1787.     YM=(Y Screen(Y Mouse)-80)/16
  1788.     MK=Mouse Key
  1789.     If Joy(1)<>JOOLD or I$<>""
  1790.       If I$=Cleft$ or Jleft(1) : X Mouse=X Hard(XM*16+8) : End If 
  1791.       If I$=Cright$ or Jright(1) : X Mouse=X Hard(XM*16+40) : End If 
  1792.       If I$=Cup$ or Jup(1) : Y Mouse=Y Hard(YM*16+72) : End If 
  1793.       If I$=Cdown$ or Jdown(1) : Y Mouse=Y Hard(YM*16+104) : End If 
  1794.       If I$=" " or Fire(1) : MK=1 : End If 
  1795.       JOOLD=Joy(1)
  1796.     End If 
  1797.     If I$=Chr$(27) Then Sprite Off : Pop Proc
  1798.     Sprite 6,X Hard(XM*16+16),Y Hard(YM*16+80),45+BAGDIR
  1799.     If F(XM,YM)<>0 and MK<>0
  1800.       If SOU
  1801.          Extension_8_13F4 Extension_8_04F8(VO),4,9000 : Add VO,1,MUS*2 To 3
  1802.       End If 
  1803.       Repeat 
  1804.         Multi Wait 
  1805.         MK=Mouse Key
  1806.       Until MK=0
  1807.     End If 
  1808.   Until MK
  1809.   If SOU
  1810.      Extension_8_13F4 Extension_8_04F8(VO),15,10000 : Add VO,1,MUS*2 To 3
  1811.   End If 
  1812.   Repeat 
  1813.     Multi Wait 
  1814.     MK=Mouse Key
  1815.   Until MK=0
  1816.   BX=XM : BY=YM
  1817.   Limit Mouse X Hard(0),Y Hard(0) To X Hard(47),Y Hard(47)
  1818.   X Mouse=X Hard(24) : Y Mouse=Y Hard(24) : VO=3 : EVOL=64
  1819.   If SOU
  1820.      Extension_8_13F4 1,-25,10000 : Extension_8_147C 1,0
  1821.      Extension_8_13F4 8,-25,8000 : Extension_8_147C 8,EVOL
  1822.   End If 
  1823.   Do 
  1824.     Clear Key 
  1825.     Repeat 
  1826.       Multi Wait 
  1827.       If SOU
  1828.         EVOL=Max(EVOL-1,16) : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1829.       End If 
  1830.       XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1831.       MK=Mouse Key : I$=Inkey$
  1832.       If I$=Cleft$ or Jleft(1) : X Mouse=X Hard(0) : Y Mouse=Y Hard(24) : MK=1 : End If 
  1833.       If I$=Cright$ or Jright(1) : X Mouse=X Hard(47) : Y Mouse=Y Hard(24) : MK=1 : End If 
  1834.       If I$=Cup$ or Jup(1) : Y Mouse=Y Hard(0) : X Mouse=X Hard(24) : MK=1 : End If 
  1835.       If I$=Cdown$ or Jdown(1) : Y Mouse=Y Hard(47) : X Mouse=X Hard(24) : MK=1 : End If 
  1836.       If I$=" " or Fire(1) : MK=1 : End If 
  1837.       XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1838.       Exit If I$=Chr$(27) or MK=2 or NUMTUBES=0,2
  1839.       Gosub GEDDIRECTION
  1840.       Sprite 6,X Hard(BX*16+16),Y Hard(BY*16+80),45+BAGDIR
  1841.       Sprite 0,X Hard(BX*16+XM),Y Hard(BY*16+YM+64),TIE
  1842.     Until MK=1 and TIE<>40
  1843.     If TARDIR<>BAGDIR
  1844.       If SOU
  1845.         EVOL=64 : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1846.       End If 
  1847.       D=Abs(TARDIR-BAGDIR)
  1848.       If D<8 : D=Sgn(TARDIR-BAGDIR) : Else D=Sgn(BAGDIR-TARDIR) : End If 
  1849.       Repeat 
  1850.         Add BAGDIR,D,0 To 15
  1851.         For A=0 To 3
  1852.           XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1853.           Sprite 6,X Hard(BX*16+16),Y Hard(BY*16+80),45+BAGDIR
  1854.           Sprite 0,X Hard(BX*16+XM),Y Hard(BY*16+YM+64),TIE
  1855.           Multi Wait 
  1856.         Next 
  1857.       Until TARDIR=BAGDIR
  1858.     End If 
  1859.     If BX+TX<0 or BX+TX>12 or BY+TY<0 or BY+TY>9
  1860.       If SOU
  1861.          Extension_8_13F4 4,13,9000
  1862.       End If 
  1863.       Repeat 
  1864.         Multi Wait 
  1865.         MK=Mouse Key
  1866.         XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1867.         Sprite 0,X Hard(BX*16+XM),Y Hard(BY*16+YM+64),TIE
  1868.         If SOU
  1869.           EVOL=Max(EVOL-1,16) : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1870.         End If 
  1871.       Until MK=0 and Fire(1)=0 and Joy(1)=0
  1872.     Else 
  1873.       If F(BX+TX,BY+TY)=0
  1874.         If SOU
  1875.           EVOL=64 : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1876.         End If 
  1877.         X=0 : Y=0
  1878.         For A=0 To 15
  1879.           XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1880.           Add X,TX : Add Y,TY
  1881.           Sprite 6,X Hard(BX*16+16+X),Y Hard(BY*16+80+Y),45+BAGDIR
  1882.           Sprite 0,X Hard(BX*16+X+XM),Y Hard(BY*16+Y+YM+64),TIE
  1883.           If A<15 : Multi Wait : End If 
  1884.         Next 
  1885.         Add BX,TX
  1886.         Add BY,TY
  1887.       Else 
  1888.         If BX+TX+TX<0 or BX+TX+TX>12 or BY+TY+TY<0 or BY+TY+TY>9
  1889.           If SOU
  1890.              Extension_8_13F4 4,23,8000
  1891.           End If 
  1892.           F=F(BX+TX,BY+TY)
  1893.           X=(BX+TX)*16+16 : Y=(BY+TY)*16+80
  1894.           SX=Rnd(16)-8 : SY=-Rnd(8)
  1895.           Sprite 2,X Hard(X),Y Hard(Y),F+1
  1896.           Multi Wait : Multi Wait 
  1897.           Ink 15,0 : Set Pattern -1
  1898.           Bar(BX+TX)*16+16,(BY+TY)*16+80 To(BX+TX)*16+31,(BY+TY)*16+95
  1899.           Put Block 1,(BX+TX)*16+16,(BY+TY)*16+80
  1900.           Repeat 
  1901.             XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1902.             Sprite 0,X Hard(BX*16+XM),Y Hard(BY*16+YM+64),TIE
  1903.             Sprite 2,X Hard(X),Y Hard(Y),F+1
  1904.             Add X,SX : Add Y,SY : Inc SY
  1905.             Multi Wait 
  1906.           Until X<-16 or X>320 or Y>256
  1907.           Add SCORE,25
  1908.           Ink 1,0 : Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  1909.           F(BX+TX,BY+TY)=0
  1910.           Sprite Off 2
  1911.           Dec NUMTUBES
  1912.         Else 
  1913.           F=F(BX+TX,BY+TY)
  1914.           If F(BX+TX+TX,BY+TY+TY)=0 and F>0
  1915.             If SOU
  1916.                Extension_8_147C 1,32
  1917.               EVOL=64 : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1918.             End If 
  1919.             X=0 : Y=0
  1920.             For A=0 To 15
  1921.               XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1922.               Add X,TX : Add Y,TY
  1923.               Sprite 6,X Hard(BX*16+16+X),Y Hard(BY*16+80+Y),45+BAGDIR
  1924.               Sprite 0,X Hard(BX*16+X+XM),Y Hard(BY*16+Y+YM+64),TIE
  1925.               Sprite 2,X Hard((BX+TX)*16+16+X),Y Hard((BY+TY)*16+80+Y),F+1
  1926.               If A<15 : Multi Wait : End If 
  1927.               If A=1
  1928.                 Ink 15,0 : Set Pattern -1
  1929.                 Bar(BX+TX)*16+16,(BY+TY)*16+80 To(BX+TX)*16+31,(BY+TY)*16+95
  1930.                 Put Block 1,(BX+TX)*16+16,(BY+TY)*16+80
  1931.               End If 
  1932.               If A=15
  1933.                 Put Block F+1,(BX+TX*2)*16+16,(BY+TY*2)*16+80
  1934.               End If 
  1935.             Next 
  1936.             Add BX,TX
  1937.             Add BY,TY
  1938.             If SOU
  1939.                Extension_8_147C 1,0
  1940.             End If 
  1941.             F(BX,BY)=0 : F(BX+TX,BY+TY)=F
  1942.             Sprite Off 2
  1943.           Else 
  1944.             If SOU
  1945.               For A=0 To 15
  1946.                 XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1947.                 Sprite 0,X Hard(BX*16+XM),Y Hard(BY*16+YM+64),TIE
  1948.                  Extension_8_13F4 8,-25,10000-Abs(7-A)*300
  1949.                 Multi Wait : Multi Wait 
  1950.               Next 
  1951.                Extension_8_13F4 8,-25,8000
  1952.               EVOL=64 : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1953.               Repeat 
  1954.                 Multi Wait 
  1955.                 XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  1956.                 MK=Mouse Key
  1957.                 Sprite 0,X Hard(BX*16+XM),Y Hard(BY*16+YM+64),TIE
  1958.                 If SOU
  1959.                   EVOL=Max(EVOL-1,16) : Extension_8_147C 8,EVOL : Extension_8_161E 8,8000-(64-EVOL)*32
  1960.                 End If 
  1961.               Until MK=0 and Fire(1)=0
  1962.             End If 
  1963.           End If 
  1964.         End If 
  1965.       End If 
  1966.     End If 
  1967.   Loop 
  1968.   If SOU Then Extension_8_1400 15
  1969.   Sprite Off 
  1970. Pop Proc
  1971. GEDDIRECTION:
  1972.   TX=(XM/16)-1 : TY=(YM/16)-1
  1973.   TIE=40
  1974.   If TX=-1 and TY=-1
  1975.     If XM-YM<0
  1976.       TX=-1 : TY=0
  1977.     Else 
  1978.       TX=0 : TY=-1
  1979.     End If 
  1980.   End If 
  1981.   If TX=1 and TY=-1
  1982.     If(47-XM)-YM<0
  1983.       TX=1 : TY=0
  1984.     Else 
  1985.       TX=0 : TY=-1
  1986.     End If 
  1987.   End If 
  1988.   If TX=-1 and TY=1
  1989.     If XM-(47-YM)<0
  1990.       TX=-1 : TY=0
  1991.     Else 
  1992.       TX=0 : TY=1
  1993.     End If 
  1994.   End If 
  1995.   If TX=1 and TY=1
  1996.     If(47-XM)-(47-YM)<0
  1997.       TX=1 : TY=0
  1998.     Else 
  1999.       TX=0 : TY=1
  2000.     End If 
  2001.   End If 
  2002.   If TX=-1 and TY=0 Then TIE=44 : TARDIR=0
  2003.   If TX=1 and TY=0 Then TIE=42 : TARDIR=8
  2004.   If TY=-1 and TX=0 Then TIE=41 : TARDIR=4
  2005.   If TY=1 and TX=0 Then TIE=43 : TARDIR=12
  2006. Return 
  2007. End Proc
  2008. Procedure WATERGO
  2009.   Shared SCORE,NUMTUBES,TIME,LEVDIF,SOU,MUS,CURVSAM,CURVFREQ
  2010.   Shared WX,WY,SX,SY
  2011.   Ink 1,0 : Text 260,176+TB,"Done:"
  2012.   X=8 : Y=8 : TUBES=0 : REALTUBES=0
  2013.   If SOU Then Extension_8_13F4 1,-1,8000
  2014.   F(SX,SY)=-Abs(F(SX,SY)) : VO=1
  2015.   Do 
  2016.     Text 260,184+TB, Extension_8_0EC8(Min(TUBES*LEVDIF,NUMTUBES*100)/NUMTUBES,4)+"%"
  2017.     OX=SX*16+16 : OY=SY*16+80
  2018.     Repeat 
  2019.        Extension_8_1030 OX+X-Abs(WY*5),OY+Y-Abs(WX*5) To OX+X+Abs(WY)*4,OY+Y+Abs(WX)*4,8,%1000
  2020.       Multi Wait 
  2021.       Add X,WX : Add Y,WY
  2022.       If X=8 and Y=8
  2023.         F=Abs(F(SX,SY))
  2024.         If P(F,2)=2
  2025.           If SOU
  2026.              Extension_8_13F4 Extension_8_04F8(VO),CURVSAM,CURVFREQ : Add VO,1,1 To 3
  2027.           End If 
  2028.           BX=X : BY=Y
  2029.           For A=1 To 4
  2030.              Extension_8_1030 OX+BX-Abs(WY*4),OY+BY-Abs(WX*4) To OX+BX+Abs(WY*3),OY+BY+Abs(WX*3),8,%1000
  2031.             Multi Wait 
  2032.             Add BX,WX : Add BY,WY
  2033.           Next 
  2034.           Gosub CHECKCURVE
  2035.         End If 
  2036.       End If 
  2037.     Until X<0 or X>15 or Y<0 or Y>15
  2038.     If X<0 Then Dec SX : Add X,16
  2039.     If Y<0 Then Dec SY : Add Y,16
  2040.     If X>15 Then Inc SX : Add X,-16
  2041.     If Y>15 Then Inc SY : Add Y,-16
  2042.     Exit If SX<0 or SX>12 or SY<0 or SY>9
  2043.     F=F(SX,SY)
  2044.     If Y=0 Then R=0
  2045.     If X=0 Then R=1
  2046.     If X=7 and Y=7 Then R=2
  2047.     If X=15 Then R=3
  2048.     If Y=15 Then R=4
  2049.     Exit If P(Abs(F),R)=0
  2050.     F(SX,SY)=-Abs(F)
  2051.     If F<0
  2052.       If SOU
  2053.          Extension_8_13F4 Extension_8_04F8(VO),12,9000 : Add VO,1,1 To 3
  2054.       End If 
  2055.       Add TUBES,3 : Add SCORE,100 : Dec REALTUBES
  2056.     End If 
  2057.     Add SCORE,25
  2058.     Gr Writing 1
  2059.     Ink 1,0 : Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  2060.     Inc TUBES : Inc REALTUBES
  2061.   Loop 
  2062.   If SOU
  2063.      Extension_8_1400 1
  2064.      Extension_8_13F4 Extension_8_04F8(VO),11,9000 : Add VO,1,1 To 3
  2065.   End If 
  2066.   For B=0 To 31
  2067.     D(B,0)=X+SX*16+14+Rnd(4) : D(B,1)=Y+SY*16+78+Rnd(4)
  2068.   Next 
  2069.   For A=1 To 32
  2070.     For B=0 To 31
  2071.        Extension_8_0388 D(B,0),D(B,1), Extension_8_039E(D(B,0),D(B,1)) or 8
  2072.       Add D(B,0),WX+(Rnd(2)-1)*WY
  2073.       Add D(B,1),WY+(Rnd(2)-1)*WX
  2074.     Next 
  2075.   Next 
  2076.   If TUBES*LEVDIF<NUMTUBES*100
  2077.     Gosub PICSAVE
  2078.     Pop Proc[1]
  2079.   End If 
  2080.   If REALTUBES=>NUMTUBES
  2081.     If SOU
  2082.        Extension_8_109E 3,43
  2083.     End If 
  2084.     For A=0 To 999
  2085.       Inc SCORE
  2086.       Ink 1,0 : Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  2087.       If(A mod 4)=0 : Multi Wait : End If 
  2088.     Next 
  2089.     If SOU
  2090.        Extension_8_10A8 
  2091.     End If 
  2092.   End If 
  2093.   If Key Shift and 8 Then Gosub PICSAVE
  2094.   If TIME
  2095.     For T=TIME To 0 Step -1
  2096.       Add SCORE,5
  2097.       T1=T/60 : T2=T mod 60
  2098.       DUMMY$=Str$(T1)+Str$(T2)
  2099.       Ink 1,0 : Text 260,136+TB, Extension_8_0EB8(T1,2)+":"+ Extension_8_0EB8(T2,2)
  2100.       Ink 1,0 : Text 260,112+TB, Extension_8_0EB8(SCORE,5)
  2101.       If SOU
  2102.          Extension_8_13EA Extension_8_04F8(VO),16 : Add VO,1,0 To 3
  2103.       End If 
  2104.       Multi Wait : Multi Wait 
  2105.     Next 
  2106.   End If 
  2107. Pop Proc[0]
  2108. PICSAVE:
  2109.   If Key Shift and 8
  2110.     Screen Open 7,320,9,2,0
  2111.     Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  2112.     Palette 0,0
  2113.     Screen Display 7,128,164,320,8
  2114.     Centre "Saving tubes record picture"
  2115.     Fade 1,0,$FFF : Multi Wait 
  2116.     Screen 0
  2117.     Trap Save Iff "TubesRecord.iff"
  2118.     Screen 7
  2119.     Fade 1 : For A=0 To 16 : Multi Wait : Next 
  2120.     Screen Close 7
  2121.   End If 
  2122. Return 
  2123. CHECKCURVE:
  2124.   If P(F,0) and WY=0 Then WY=-1 : WX=0 : Return 
  2125.   If P(F,1) and WX=0 Then WY=0 : WX=-1 : Return 
  2126.   If P(F,3) and WX=0 Then WY=0 : WX=1 : Return 
  2127.   If P(F,4) and WY=0 Then WY=1 : WX=0 : Return 
  2128. Return 
  2129. End Proc
  2130. Procedure NEWRND[NR]
  2131.   Reserve As Work 16,(NR and $FFFE)+10
  2132.   B=0 : ST=Start(16)
  2133.   For A=0 To NR-1
  2134.     Poke ST+A,B+1
  2135.     Add B,1,0 To 7
  2136.   Next 
  2137.   For A=0 To NR-1
  2138.     B=Rnd(NR-1)
  2139.     A1=Peek(ST+B)
  2140.     Poke ST+B,Peek(ST+A)
  2141.     Poke ST+A,A1
  2142.   Next 
  2143. End Proc
  2144. Procedure CLRHISC
  2145.   For A=1 To 15
  2146.     HISC(A,0)=(16-A)*1000
  2147.     HISC(A,1)=(16-A)
  2148.     HISC$(A)="NO NAME YET!"
  2149.   Next 
  2150. End Proc
  2151. Procedure LOAHISC
  2152.   If Exist("Tubes.his")=0 Then CLRHISC : SAVHISC : Pop Proc
  2153.    Extension_8_0456 "Tubes.his",8
  2154.   ST=Start(8)
  2155.   For A=1 To 15
  2156.     HISC$(A)=Peek$(ST,12) : Add ST,12
  2157.     HISC(A,0)=Deek(ST) : Add ST,2
  2158.     HISC(A,1)=Deek(ST) : Add ST,2
  2159.   Next 
  2160. End Proc
  2161. Procedure SAVHISC
  2162.   Reserve As Work 8,15*(12+2+2)
  2163.   ST=Start(8)
  2164.   For A=1 To 15
  2165.     Poke$ ST,HISC$(A) : Add ST,12
  2166.     Doke ST,HISC(A,0) : Add ST,2
  2167.     Doke ST,HISC(A,1) : Add ST,2
  2168.   Next 
  2169.   Request Off 
  2170.   Trap Extension_8_0472 "Tubes.his",8
  2171.   Request On 
  2172.   Erase 8
  2173. End Proc